perm filename SAIL[S,AIL]42 blob
sn#261605 filedate 1977-02-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00046 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 HISTORY
C00014 00003
C00015 00004 Command File Descriptions
C00017 00005 Titles, Switch Settings
C00019 00006 HISTORY OF STUFF THAT USED TO BE IN HEAD
C00023 00007 DSCR EXCHOP
C00024 00008 DSCR LODBLK (TYPE,TYP1,NAME,NAME1,COUNT,COUNT1,RELOC)
C00027 00009 MACROS FOR MANIPULATING SEMBLKS (SEE SAIL DATA DESCRIPTIONS)
C00029 00010 MACROS FOR MANIPULATING SEMANTICS, CALLING GENERATOR ROUTINES,
C00034 00011 Q-STACK HANDLERS
C00038 00012 Sail ACs, File Indices
C00040 00013 Sail Bits
C00048 00014 Externals, Data Allocation
C00051 00015 ZERODATA (MAIN-SEMANTICS POINTERS)
C00060 00016 II. SEMANTICS VARIABLES
C00071 00017 ZERODATA(DISPLAY REGISTER HANDLING VARIABLES)
C00073 00018 ZERODATA (MAIN-SCANNER VARIABLES)
C00077 00019 ZERODATA (MAIN-PARSER VARIABLES)
C00088 00020 ZERODATA (MAIN-SOURCE AND LISTING FILE VARIABLES)
C00092 00021 DATA (SWITCHED VARIABLES)
C00102 00022 ZERODATA (GLOBAL STATE VARIABLES)
C00105 00023 ZERODATA (COUNTER SYSTEM VARIABLES)
C00107 00024 DATA (RANDOM GLOBAL THINGS)
C00110 00025 SLS VARIABLES
C00112 00026 DATA (INITIAL PROC DESC SEMBLKS)
C00113 00027 Executive and Initialization
C00115 00028 Start, Ddtkil -- Once-only code to zap RAID, symbols
C00120 00029 Larger, Sail -- Execution Starts Here
C00126 00030
C00129 00031 Morfiles -- Execution Returns Here Each New Command Line
C00137 00032
C00142 00033 Salnit -- Storage Initialization, Etc.
C00152 00034 XTCOPY, RESTORE PREVIOUS STATE OF .REL FILE
C00158 00035 Comnd, aux. routs -- Command Scanner
C00163 00036 Opnup -- Open Files
C00166 00037 Comnd Itself
C00179 00038 Unswt -- End of Switched-to-File
C00181 00039 Filnam
C00191 00040 Delim -- Handle Switches
C00194 00041
C00197 00042
C00203 00043
C00205 00044 Word
C00208 00045 Tyi
C00212 00046
C00213 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,FAIL,REASON
031 102200000016 ⊗;
DEFINE .VERSION <102200000017>
COMMENT ⊗
VERSION 18-1(12) 3-1-75 BY RLS ADD TNXBND FOR TENEX ADVBUF -- (SHOULD BE DONE FOR DEC TOO PROBABLY)
VERSION 18-1(11) 2-16-75 BY JFR BAIL FLAG FOR REQUESTING SYS:BAIPDn.REL P.24
VERSION 18-1(10) 2-15-75 BY RLS JUST LOOKING
VERSION 18-1(9) 2-15-75 BY RLS TENEX CHANGE -- PUT SRCTTY IN SWITCHED AREA
VERSION 18-1(8) 2-1-75 BY JFR BAIL FLAG FOR SKIPPING SYS:BAIL.REL P.24
VERSION 18-1(7) 2-1-75 BY RLS MAKE EXPR!TYPE RECURSIVE
VERSION 18-1(6) 2-1-75 BY RLS MAKE EXPR!TYPE RECURSIVE
VERSION 18-1(5) 11-27-74 BY JFR AVLSRC BEING SET INCORRECTLY P. 31
VERSION 18-1(4) 11-7-74 BY JFR KEEP TRACK OF PPN IN CDB
VERSION 18-1(3) 10-20-74 BY RHT FEAT %BT% -- MAKE OUTER BLOCK PD LOOK BETTER
VERSION 18-1(2) 10-18-74 BY RHT JUST CHECKING
VERSION 18-1(1) 10-17-74 BY RHT VERSION 18
VERSION 17-1(54) 10-16-74 BY JFR JUST CHECKING
VERSION 17-1(53) 10-16-74 BY JFR FIX BAIL SOURCE FILE COUNTING
VERSION 17-1(52) 10-10-74 BY RLS PARAMETERIZE DEFAULT DEF STACK SIZE
VERSION 17-1(51) 9-26-74 BY JFR FILE NAMES OUTPUT TO .SM1 FILE
VERSION 17-1(50) 9-20-74 BY JFR INSTALL BAIL
VERSION 17-1(49) 9-20-74
VERSION 17-1(48) 9-20-74
VERSION 17-1(47) 9-20-74
VERSION 17-1(46) 9-20-74 BY RHT FIX RHT'S STUPID MISTAKE
VERSION 17-1(45) 5-28-74 BY RHT BUG #SD# ADD NEW FLAG (IEFLAG)
VERSION 17-1(44) 4-12-74 BY RHT ADD BIT TO ALLTYPS
VERSION 17-1(43) 4-6-74 BY RLS EDIT
VERSION 17-1(42) 4-6-74 BY RLS TENEX FIX TO PARC LOADER INTERFACE
VERSION 17-1(41) 3-25-74 BY JRL WE NOW USE LOADER 54 BLOCK CODES (LIBRARIES, LOAD MODULES)
VERSION 17-1(40) 3-19-74 BY RHT LOOK AT RS ADDITIONS
VERSION 17-1(39) 3-17-74 BY RLS EDIT
VERSION 17-1(38) 3-17-74 BY RLS TENEX FEATURES
VERSION 17-1(37) 1-11-74 BY RHT TURN OFF BAISW (DAMMIT!!!)
VERSION 17-1(36) 1-11-74 BY JRL CMU CHANGE PPN'S DDTKIL
VERSION 17-1(35) 1-11-74
VERSION 17-1(34) 1-11-74
VERSION 17-1(33) 1-11-74
VERSION 17-1(32) 1-6-74 BY KVL ADD %BC% BAIL SYMBOL OUTPUTTING STUFF
VERSION 17-1(31) 12-7-73 BY JRL BUG #PS# DELAY SETTING UP OF MYERR
VERSION 17-1(30) 12-7-73 BY RHT DITTO
VERSION 17-1(29) 12-7-73 BY RHT NO REAL REASON
VERSION 17-1(28) 12-7-73
VERSION 17-1(27) 12-7-73
VERSION 17-1(26) 12-7-73 BY rht get .version back
VERSION 17-1(25) 12-6-73 BY JRL REMOVE AS MANY SPECIAL STANFORD CHARACTERS AS POSSIBLE
VERSION 17-1(24) 12-4-73 BY RHT BUG #PN# NEEDED TO GET JOBFF OK AT START -- DID RESET TO FIX
VERSION 17-1(23) 12-4-73
VERSION 17-1(22) 12-3-73 BY RHT TURN CALL INTO A CALL6
VERSION 17-1(21) 12-3-73 BY RHT FEAT %AY% USE INTMAP RUNTIME ROUTINE
VERSION 17-1(20) 12-3-73
VERSION 17-1(19) 12-2-73 BY RHT GET BACK AN OLDER VERSION AFTER DISASTER
VERSION 17-1(18) 11-25-73 BY RHT FEAT %AO% .SEG2. MAY DO A SETPR2
VERSION 17-1(17) 11-24-73 BY RHT FEAT %AL% MAKE OUTER BLOCK LOOK LIKE A PROCEDURE
VERSION 17-1(16) 11-24-73
VERSION 17-1(15) 11-24-73 BY RHT TRANSFER IN STUFF THAT USED TO BE IN HEAD
VERSION 17-1(14) 11-24-73
VERSION 17-1(13) 11-24-73
VERSION 17-1(12) 11-24-73
VERSION 17-1(11) 11-24-73
VERSION 17-1(10) 11-24-73
VERSION 17-1(9) 11-24-73
VERSION 17-1(8) 11-24-73
VERSION 17-1(7) 11-22-73 BY RHT INCREASE DATA AREAS
VERSION 17-1(6) 11-22-73 BY RHT FIX KVL TYPO
VERSION 17-1(5) 11-10-73 BY KVL INSERT CHANGES TO LOG ERR UUO
VERSION 17-1(4) 9-19-73 BY HJS ADD EVALREDEFINE AND CVPS
VERSION 17-1(3) 8-17-73 BY JRL MAKE LOADVR=52 ONLY FOR NOEXPR
VERSION 17-1(2) 8-16-73 BY jrl ifn out references to LEP
VERSION 17-1(1) 8-6-73 BY HJS BUG #NO# FIX EXTRA ENDC,ELSEC ERROR MESSAGE
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 !!! ***
VERSION 16-2(56) 7-26-73 BY JRL INCREASE ZERODATA SIZE FOR NON FTDEBUG
VERSION 16-2(55) 7-11-73
VERSION 16-2(54) 7-11-73
VERSION 16-2(53) 6-19-73 BY HJS IFCR, REDEFINE, EVALDEFINE, AND ASSIGNC IMPLEMENTATION
VERSION 16-2(52) 5-17-73 BY HJS INITIALIZE ENDC COUNTER TO -1
VERSION 16-2(51) 3-15-73 BY JRL BUG #LT# <SOURCE-FILE NOT FOUND > ERRMSG
VERSION 16-2(50) 3-13-73 BY JRL REMOVE REFERENCES TO GAG,WOM,SLS,NODIS
VERSION 16-2(49) 12-13-72
VERSION 16-2(48) 12-13-72 BY JRL BUG #KS# ADD LOADVR SWITCH
VERSION 16-2(47) 11-14-72 BY RHT MAKE .REL FILES DUMP NEVER
VERSION 16-2(46) 11-13-72 BY RHT BUG #KC# -- PDA,,0 FIXUP FOR HIGH SEG MESSED UP
VERSION 16-2(45) 9-27-72 BY HJS FORCE EXECUTION OF BLOCK WHEN A DEFINE IS THE ONLY DECLARATION IN THE BEGINNING OF A BLOCK.
VERSION 16-2(44) 8-13-72 BY DCS UPDATE COMMAND FILE DESCRIPTIONS
VERSION 16-2(41) 7-5-72 BY DCS BUG #IH# KEEP RAID IN DISK FILE, NOT CORE IMAGE
VERSION 16-2(40) 7-2-72 BY RHT INCREASE ZSIZE FOR NON FTDEBUG PART
VERSION 16-2(39) 6-25-72 BY DCS BUG #HX# PARAMETERIZE PROCESSOR NAME, DEFAULT EXT
VERSION 16-2(38) 6-21-72 BY RHT CHANGE THE WAY PDA,,0 SEMBLK IS LINKED
VERSION 16-2(37) 5-14-72 BY DCS BUG #HH# BETTER INITIAL CODE IF /H
VERSION 15-6(18-36) 4-6-72 LOTS OF THINGS
VERSION 15-6(17) 2-21-72 BY HJS THE BRAVE NEW PARSER WORLD
VERSION 15-6(12) 2-18-72 BY RHT THE BRAVE NEW WORLD
VERSION 15-6(11) 2-10-72 BY DCS BUG #GR# MINOR FTDEBUGGER FIXES
VERSION 15-6(10) 2-6-72 BY DCS BUG #GP# CHECK FORWARD FORMALS AGAINS REAL FORMALS
VERSION 15-6(9) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
VERSION 15-6(8) 2-1-72 BY DCS BUG #GH# USE INTERRUPTS TO DO ASYNCH BREAKS, 6M MEANS SCAN BREAK
VERSION 15-6(7) 2-1-72 BY DCS BUG #GE# MODIFY FOR NEW %ALLOC INTERFACE
VERSION 15-6(6) 1-3-72 BY DCS BUG #FX# REMOVE COM2, COM2SW COMPLETELY
VERSION 15-6(5) 12-24-71 BY DCS BUG #FF# ADD FILE NAME ID TO FILE NOT FOUND MSG
VERSION 15-6(4) 12-22-71 BY DCS BUG #FT# ADD BINLIN
VERSION 15-6(3) 12-22-71 BY DCS BUG #FS# REMOVE SAILRUN, MOST COM2 CONDITIONALS
VERSION 15-2(2) 12-2-71 BY DCS SET UP VERSION NUMBER IN OBJECT COMPILER
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
COMMENT ⊗
There was a compiler named SAIL,
Assembled and coded in FAIL.
Its authors, they say
(one glorious day)
Were run out of town on a rail.
⊗
COMMENT ⊗Command File Descriptions
The following command files make compilers:
1. IT
Standard Stanford Sail compiler, 1 or 2 segments, Leap, Global, no Debugging
RESTAB.=PROD+FOO2/NOLIST/NOLO/NON RTRAN
PROD.=HEL/NOLIST/NOLO/NON PTRAN
SAIL=CALLIS(LR)+HEAD+FILSPC+SAIL+PARSE+HEL+FOO2+PROD/FORWARD+RESTAB/FORWARD ;
+SYM+GEN+ARRAY+EXPRS+STATS+LEAP+TOTAL+PROCSS+COMSER
2. THAT
Same, except Debugging turned on
RESTAB.=PROD+FOO2/NOLIST/NOLO/NON RTRAN
PROD.=HEL/NOLIST/NOLO/NON PTRAN
SAIL=CALLIS(LR)+HEAD+FILSPC+DB+SAIL+PARSE+HEL+FOO2+PROD/FORWARD+RESTAB/FORWARD ;
+SYM+GEN+ARRAY+EXPRS+STATS+LEAP+TOTAL+PROCSS+COMSER
3. There will eventually be a file to make a truly two-segment SAIL.
⊗
COMMENT ⊗Titles, Switch Settings⊗
TITLE SAIL -- Stare at it Later
SUBTTL D. SWINEHART, R. SPROULL -- FEBRUARY 1969
; Revised as of 20 Mar 1971 DCS-RFS
SUBTTL SAIL ASSEMBLY SPECIFICATIONS
LSTON (SAIL) ;LIST IF ENABLED
BIT2DATA (CONDITIONAL ASSEMBLY SWITCHES)
; ** CONDITIONAL SETTINGS **
;?SAILRUN←←-1 ;SWITCH USED NO LONGER
?LEAPSW ←←1 ;IT CAN DO LEAP
; (IF YOU MAKE IT 0, ALSO REMOVE THE LEAP
; STUFF FROM HEL, THE PRODUCTION COMPILER)
;; #KS BY JRL LOADVR SWITCH
STSW (LOADVR,=54) ;ASSUME LOADER 54
STSW (FTDEBUG,0) ;DON'T USUALLY DEBUG (MUST BE 0 OR 1)
STSW (RENSW,1) ;USUALLY ALLOW RE-ENTRANT CODE GENERATION
NOEXPO <
?GLOBC←←1 ;DON'T USUALLY DO GLOBAL UNLESS
>;NOEXPO
STSW (GLOBC,0) ;STANFORD LEAP COMPILER
?PATSW←←0 ;ON UNTIL GET NEW SEGMENT UP
STSW (PATSW,0) ;IF SET, INCLUDE AOS `PAT' ON ENTRY,
; SOS `PAT' ON EXIT FROM PROC (Proc Active Tally)
?TIMER←←0 ;IF SET, INCLUDE A LITTLE TIMER TO SEE HOW
; THINGS GO. THIS IS A LITTLE INSTRUCTION
; INTERPRETER IN FILE "PARSE"
;; ! JFR 10-19-75 used to be 0 for Stanford
STSW (TMPCSW,1)
;; %AZ% BY KVL (1/3/74)
; ** **
ENDDATA
COMMENT ⊗HISTORY OF STUFF THAT USED TO BE IN HEAD
AUTHOR,REASON
021 102100000002 ⊗;
COMMENT ⊗
VERSION 17-2(47) 11-10-73 BY RHT ADD CORERR, ERRPRI, ERFLGS BITS
VERSION 17-1(46) 7-26-73 BY RHT TRY VERSION 17
VERSION 17-1(45) 7-26-73 *********************
VERSION 16-2(44) 7-9-73 BY JRL REMOVE LAST REFERENCES TO DCS SWITCH
VERSION 16-2(43) 4-23-73 BY RHT CHANGE ARGTYP TO RFITYP
VERSION 16-2(42) 2-7-73 BY RHT ADD TYPE FOR ARG LIST ITEM
VERSION 16-2(41) 1-28-72 BY JRL PUT QBIND,FBIND HERE SO STATS CAN USE
VERSION 16-2(40) 1-23-73 BY RHT MAKE NIC & UNBOUND THE SAME
VERSION 16-2(39) 1-23-73 BY JRL CHANGE CODE FOR UNBND
VERSION 16-2(38) 1-8-73 BY JRL ADD MAXLOC MAXIMUM NUMBER OF FOREACH LOCAL ITEMVARS ALLOWED
VERSION 16-2(37) 12-13-72 BY jrl BUG #KS# ADD LOADVR SWITCH
VERSION 16-2(36) 11-21-72
VERSION 16-2(35) 11-10-72 BY HJS MODIFY QPOP TO TAKE AS AN ARGUMENT AN ADDRESS FOR THE POPPED ENTRY
VERSION 16-2(34) 10-16-72 BY JRL CHANGE INVTYP TO 31 TO ALLOW CONTEXT ARRAY ITEMS
VERSION 16-2(33) 9-15-72 BY RHT ADD USER TABLE ENTRIES FOR INTERRUPTS
VERSION 16-2(32) 8-27-72 BY RHT PUT CELL FOR STACK UNWINDER RET ADRS IN USER TABLE
VERSION 16-2(31) 8-23-72 BY JRL ADD UNBND "ITEM"
VERSION 16-2(30) 8-20-72 BY RHT MODIFY USER TABLE
VERSION 16-2(29) 8-6-72 BY RHT ADD PRILIS TO USER TABLE
VERSION 16-2(28) 8-3-72 BY JRL ADD MPBIND TO TBITS DEFS FOR MATCHING PROCEDURES
VERSION 16-2(27) 7-27-72 BY RHT MAKE MACRO FOR DECLARING PD. ENTRIES
VERSION 16-2(26) 7-20-72 BY JRL CHANGE ARRTYP VALUE
VERSION 16-2(25) 7-20-72 BY RHT ADD PROCESS ITEM (TYPE 11)
VERSION 16-2(24) 6-20-72 BY DCS BUG #HU# BETTER TTY INFORMATION
VERSION 16-2(23) 5-16-72 BY DCS INTRODUCE VERSION 16
VERSION 15-2(9-22) 5-4-72 LOTS OF THINGS
VERSION 15-2(8) 2-19-72 BY RHT THE BRAVE NEW WORLD
VERSION 15-2(7) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
VERSION 15-2(6) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR DUE TO NEW `CAT'
VERSION 15-2(5) 2-1-72 BY DCS BUG #GE# INSTALL SYMB %ALLOC BLK INDICES
VERSION 15-2(4) 1-31-72 BY DCS BUG #GE# UPDATE USER TABLE, %ALLOC BITS, INDICES
VERSION 15-2(3) 1-3-72 BY DCS BUG #FX# REMOVE COM2, COM2SW COMPLETELY
VERSION 15-2(2) 12-24-71 BY DCS BUG #FF# REMOVE SAILRUN(ASSUME RUNTIM OR LIB)
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
DSCR EXCHOP
DES Exchange Semantic entries in PNT,TBITS,SBITS with those
in PNT2,TBITS2,SBITS2 -- since "GENMOV" routines generally
operate on the first set of ACs.
⊗
DEFINE EXCHOP <
EXCH PNT,PNT2
EXCH TBITS,TBITS2
EXCH SBITS,SBITS2 >
DSCR MOVOPS
DES Copy Semantic entries from PNT,TBITS,SBITS into
PNT2,TBITS2,SBITS2
⊗;
DEFINE MOVOPS <
MOVE PNT2,PNT
MOVE TBITS2,TBITS
MOVE SBITS2,SBITS
>
DSCR LODBLK (TYPE,TYP1,NAME,NAME1,COUNT,COUNT1,RELOC)
CAL MACRO
PAR TYPE, TYP1 are the symbolic and numeric reps of
a LOADER block type
NAME, NAME1 are the labels to be given the block and
its descriptor (optional, see below)
COUNT, COUNT1 are the data count and the total count
for the descriptor (optional, etc.)
RELOC describes the initial relocation bits
RES if NAME1 is present, a descriptor word is put out
to provide GBOUT with count info for entire block
Then the Type,,count word is output, labeled NAME
Following is the RELOC word, then a block long enough
to hold data
SEE GBOUT, Loader blocks (ENTTAB, BINTAB, etc.)
⊗
DEFINE LODBLK (TYPE,TYP1,NAME,NAME1,COUNT,COUNT1,RELOC) <
; Create LOADER OUTPUT BLOCK of type TYPE (really the
; integer TYP1. Name it NAME. Give it a data count
; of COUNT. If there is a NAME1, create a descriptor
; for GBOUT of the form [(COUNT1 or COUNT+2),,NAME].
; Issue a reloc word of (RELOC or 0).
; Put out a COUNT-word block for holding the data
IFNB (NAME1) <
;DESCRIPTOR FOR GBOUT ROUTINE
↑↑NAME1:
IFNB (COUNT1) <
XWD COUNT1,NAME;> XWD COUNT+2,NAME
>
;LOADER BLOCK HEADER
↑↑NAME: XWD TYP1,COUNT
;RELOCATION BITS
IFNB (RELOC) <
RELOC;> 0
;DATA WORDS
BLOCK COUNT
>;LODBLK
; MACROS FOR MANIPULATING SEMBLKS (SEE SAIL DATA DESCRIPTIONS)
DSCR GETBLK (X)
CAL MACRO
PAR X is address (optional)
RES into LPSA (and X) is put address of new Semblk (zeroed)
SID LPSA, X changed -- probably TEMP too
SEE BLKGET, the routine it calls, and main SAIL data descriptions
⊗
DEFINE GETBLK ( X ) <
PUSHJ P,BLKGET
IFDIF <X><>,<HRRM LPSA,X>>
DSCR FREBLK (X)
CAL MACRO
PAR X (optional) is address of Semblk (LPSA is default)
RES Semblk is released to free Semblk list
SID TEMP, LPSA changed
SEE BLKFRE, the routine used, and main SAIL data descriptions
⊗
DEFINE FREBLK ( X ) <
IFIDN <><X>,<PUSH P,LPSA;> PUSH P,X
PUSHJ P,BLKFRE
>
; TAKE CDR OF A LINKED LIST, GOING ALONG LINK Y. GO TO Z
; IF LIST IS EXHAUSTED.
DEFINE RIGHT (X,Y,Z ) <
IFDIF <X><>,<MOVE LPSA,X>
HRRZ LPSA,Y(LPSA)
IFDIF <Z><>,<JUMPE LPSA,Z>>
; SAME FOR MOVING LEFT ALONG A LINK.
DEFINE LEFT (X,Y,Z) <
IFDIF <><X>,<MOVE LPSA,X>
HLRZ LPSA,Y(LPSA)
IFDIF <><Z>,<JUMPE LPSA,Z>>
; MACROS FOR MANIPULATING SEMANTICS, CALLING GENERATOR ROUTINES,
; GENERATING CALLS ON RUNTIME ROUTINES ON BEHALF OF COMPILED CODE, ETC.
; PICK UP SEMANTICS WORDS FOR A PARSER TEMPORARY.
DEFINE GETSEM (X) <
MOVE PNT,GENLEF+X
PUSHJ P,GETAD >
; SAME, BUT PUT SEMANTICS IN TBITS2,SBITS2
DEFINE GETSM2 (X) <
MOVE PNT2,GENLEF+X
PUSHJ P,GETAD2 >
DSCR GENMOV (Z,X,Y)
DES MACRO TO FACILITATE CALLING GENERATOR SUBROUTINES.
PAR Z IS ROUTINE NAME.
X IS FLAGS (OPTIONAL)
Y IS TYPE (INTEGER,,,) TO BE PASSED IN REGISTER B.
RES Calls routine after setting up AC's.
⊗;
DEFINE GENMOV (Z,X,Y) <
IFDIF <X><>,<HRRI FF,X>
IFDIF <Y><>,<HRRI B,Y>
;;#YR# JFR 2-2-77
IFE <<X>≠<PROTECT!UNPROTECT>>&<PROTECT!UNPROTECT>,<
;BOTH PROTECT AND UNPROTECT ARE ON. PRESUMABLY THIS MEANS YOU WANT
;TO PROTECT THE AC GIVEN IN RH(D), INVOKE 'GET' OR 'ACCESS' (ETC.),
;THEN UNPROTECT WHAT YOU ORIGINALLY PROTECTED. UNFORTUNATELY
;'GET' PROBABLY CHANGED D. THIS CAUSED ABSOLUTELY HORRIBLE WRONG CODE
;WITH NO ERROR MESSAGE. TRY TO CORRECT DESIGN ERROR.
PUSH P,D ;SAVE AC
PUSHJ P,Z ;ORIGINAL ROUTINE
EXCH D,(P)
HRRI FF,UNPROTECT
PUSHJ P,POST
POP P,D>
IFN <<X>≠<PROTECT!UNPROTECT>>&<PROTECT!UNPROTECT>,<
;ONE OR THE OTHER OF PROTECT, UNPROTECT IS OFF.
PUSHJ P,Z>
;;#YR# ↑
>
DSCR XCALL (X)
CAL MACRO
DES Facilitates calling runtine functions.
PAR X is the "NAME" of such a function, all of which
are named in the beginning of the file "GEN"
RES a call (PUSHJ) to the routine is generated and fixed up
SID AC A is clobbered.
SEE XCALLQ
⊗;
DEFINE XCALL ' (X) <
MOVEI A,LIBTAB+R'X ;FIXUP LOCATION.
PUSHJ P,XCALLQ
>
DSCR LPCALL (X,Y,Z)
CAL MACRO
DES Facilitates EMITting calls to LEAP interpreter
functions.
PAR X is function "NAME" (list is located at beginning of file "LEAP")
Y (optional) displacement from X.
Z tells what kind of call it is. If non-null, we use the
index computed by STCHK (Q.V.) to add to X, otherwise
just the type bits computed by STCHK.
SEE LEAPC1, LEAPC2, STCHK
⊗;
DEFINE LPCALL ' (X,Y,Z) <
MOVEI A,L'X ;ROUTINE NAME.
IFDIF <Y><>,<ADD A,Y>
IFIDN <Z><>,<PUSHJ P,LEAPC1;> PUSHJ P,LEAPC2
>
DSCR XPREP
CAL MACRO
DES Make sure AC 1 is free (I.E. erase the ACKTAB entry for it --
so that a call on a runtime routine which returns a result
in AC 1 can now be EMITted.
SEE STORZ
⊗;
DEFINE XPREP <
PUSHJ P,[
HRRI D,1
JRST STORZ]
>
;;%DU% 2ND AC OF LONG REAL PROCEDURE
DEFINE XPREP2 <
PUSHJ P,[
HRRI D,2
JRST STORZ]
>
DSCR EMIT (INSTR)
CAL MACRO
DES Facilitates calling the EMITTER for us.
PAR INSTR is the instruction and "DIRECTIVE" bits to the
EMITTER.
⊗;
DEFINE EMIT (INSTR) <
IFDIF <INSTR><>,<MOVE A,[INSTR]>
PUSHJ P,EMITER ;CALL EMITER
>
; Q-STACK HANDLERS
DSCR QPUSH (X,Y)
CAL MACRO
DES calls the generalized stack routine BPUSH.
PAR X (optional) is name of stack to be used.
Y (optional) is data word to be pushed (AC A).
SID A, LPSA, TEMP changed
SEE BPUSH
⊗
DEFINE QPUSH (X,Y) <
IFDIF <X><>,<MOVEI LPSA,X>
IFDIF <Y><>,<MOVE A,Y>
PUSHJ P,BPUSH >
DSCR QPOP
CAL MACRO
DES Facilitates calls on generalized stack routine BPOP
PAR X is name of the stack to be used (optional).. otherwise
pointer in LPSA.
Y (optional) is where the popped entry is to be returned.
RES Popped entry is returned in AC A and Y (optional).
SEE BPOP
⊗;
DEFINE QPOP (X,Y) <
IFDIF <X><>,<MOVEI LPSA,X>
PUSHJ P,BPOP
IFDIF <Y><>,<MOVEM A,Y> >
DSCR QLOOK
CAL MACRO
DES Allows one to get hold of the top element in the Qstack X
PAR X is the name of the stack to be used
RES the pointer to the top element in the stack is returned in AC A.
⊗
DEFINE QLOOK (X) <
HLRZ A,X >
DSCR QTAKE (X)
CAL MACRO
DES facilitates "taking" things out of one of the generalized
QSTACKS (uses routine QTAK).
PAR X is name of Qstack to be used.
AC B must have a QPUSH/QPOP-like pointer to the element requested.
RES Popped result returned in register A.
**** SKIPS IF SUCCESSFUL ****
SEE QTAK
⊗;
DEFINE QTAKE (X) <
IFDIF <X><>,<MOVEI LPSA,X>
PUSHJ P,QTAK >
DSCR QBACK
CAL MACRO
PAR In AC B must be a QSTACK descriptor
RES B's descriptor is "popped" by one, word put in AC A.
No storage is released
**** SKIPS IF SUCCESSFUL ****
DES See BBACK routine in TOTAL for details of operation, AC usage, etc.
SEE BBACK
⊗
DEFINE QBACK <
PUSHJ P,BBACK
>
DSCR QFLUSH (X)
CAL MACRO
PAR Qstack descriptor address
RES All storage is released for the stack, and the descriptor
address is zeroed.
DES Used when QBACK and QTAKE operations have left blocks around.
There should always be one actual PDP-type cell which points
to the top (is only used in QPUSH and QPOPs). This should be
pointed at to flush the stack.
SEE BFLUSH
⊗
DEFINE QFLUSH (X) <
IFDIF <><X> <
MOVEI LPSA,X
>
PUSHJ P,BFLUSH
>
DSCR QBEGIN (X)
CAL MACRO
PAR X PTR TO A QPDP, LOADED TO LPSA IF PRESENT
RES B contains QPDP for QTAKEing first word, 0 if no stack
SEE BBEG
⊗
DEFINE QBEGIN (X)<
IFDIF <><X> <
MOVEI LPSA,X
>
PUSHJ P,BBEG
>
;;; THE VERY FIRST LOCATION
?LPSERR: ERR <DRYROT -- SYMBOL TABLE>
SUBTTL Sail ACs, File Indices
BEGIN SAIL
AC2DATA (GLOBALLY USED ACS)
?FF ←←0 ;FLAG WORD, POSSIBLY
?A ← 1 ;TEMPORARY AC'S -- MAY
?B ← 2 ; RETAIN VALUES OVER SUBROUTINE
?C ← 3 ; CALLS AS LONG AS EVERYONE UNDERSTANDS
?D ← 4 ; WHAT IS HAPPENING.
?PNT ← 5 ;PTR TO SYMBOL ENTRY FOR GENERATORS, ENTER, ETC.
?TBITS ← 6 ;"TYPE" BITS FOR SYMBOL ENTRY
?SBITS ← 7 ;"SEMANTIC" (MORE RANDOM GOOD) BITS FOR SAME
?PNT2 ←10 ;SAME FOR 2D ARGUMENT IN
?TBITS2 ←11 ; BINARY CASES -- MAY BE OTHERWISE USED
?SBITS2 ←12 ; IF ONE IS CAREFUL
;?SP ;STRING PUSH-DOWN STACK -- COMPILER PUSH-DOWN STACKS
;?TEMP ;USE FOR EXTREMELY TEMPORARY PURPOSES
;?USER ;LPS PARAMETER-PASSING ACS -- USE ALSO
;?LPSA ; FOR HOLDING POINTERS, BUT BE CAREFUL
;?P ;"SYSTEM" PUSH-DOWN POINTER
; SAIL I/O CHANNELS
?SRC ←←1 ;SOURCE FILE CHANNEL
?BIN ←←2 ;BINARY
?LST ←←3 ;LISTING
?CMND ←←4 ;COMMAND
?LOG ←←5 ;LOGGING FILE CHANNEL
;; %BC% ADD BAIL SYMBOL OUTPUTS
BAIL <
?SM1 ←←6 ;NAME FILE FOR SYMBOLS
>;BAIL
;; %BC%
XCOM<
?TMQ ←←17 ;TEMP CHAN FOR COPYING
>;XCOM
ENDDATA
SUBTTL Sail Bits
; BIT MASKS FOR GENERATORS
BIT2DATA (TBITS, SBITS WORDS)
; LEFT HALF BITS -- TBITS WORD
; THESE ARE THE BITS STORED IN SYMBOL TABLE ENTRIES ABOUT
; EACH USER'S IDENTIFIER, OR EACH CONSTANT (SCANNED OR CREATED).
DEFINE BIT (NAME,BITT) <
IFNDEF NAME, <IFDIF <NAME><SPARE>,<?NAME←←BITT>>
IFN FTDEBUG, <
IFIDN <NAME> <SPARE> , < 0
>
IFDIF <NAME> <SPARE> ,< RADIX50 0,NAME
>>>
; THIS WILL DEFINE THE LOCATIONS USED IN DEBUGGING
IFN FTDEBUG, <
BITABLE: XWD .+1,BTBITS
XWD .+1,BSBITS
XWD .+1,GENBTS
ARRBTS
>
BTBITS:
DEFTBS ;MACRO CALL TO DEFINE THEM
?FORMAL ←← VALUE!REFRNC ;FORMAL PARAMETER IS EITHER TYPE.
ALTYPS ←←FORTRAN+PROCED+ITMVAR+PNTVAR+BOOLEAN+ITEM
ALTYPS ←←ALTYPS+STRING+SET+LABEL+LSTBIT+DBLPRC+INTEGR+FLOTNG
?ALTYPS←←ALTYPS
?SNGTYP ←← ITEM+ITMVAR+PNTVAR+INTEGR+FLOTNG+SET+DBLPRC+BOOLEAN+LSTBIT
;LEFT HALF BITS -- SBITS WORD.
BSBITS: BIT (INUSE,400000) ;TEMP IN USE
BIT (ARTEMP,200000) ;ARITHMETIC TEMP
BIT (STTEMP,100000) ;STRING (STACKED) TEMP
BIT (INAC,40000) ;VARIABLE OR TEMP IN ACCUMULATOR
BIT (FREEBD,20000) ;ITEMVAR MAY BE FREE OR BOUND
BIT (NEGAT,10000) ;SAYS THIS THING IS IN AC NEGATIVELY.
BIT (INDXED,4000) ;REPRESENTS CALCULATED ARRAY POINTER.
BIT (CORTMP,2000) ;REAL-LIVE TEMPORARY CORE LOCATION.
BIT (PTRAC,1000) ;POINTER TO ARGUMENT IS IN AC.
BIT (RTNDON,400) ;SOMEBODY RETURNED FROM THIS (TYPED) PROCEDURE
BIT (LPFRCH,200) ;THIS THING IS IN THE CURRENT FOREACH LIST.
BIT (LPFREE,100) ;THIS THING IS STILL "FREE"
BIT (FIXARR,40) ;TEMP CELL REPRESENTS ARR[CONST]
BIT (KNOWALL,20) ;USED BY ARRAY CODE ONLY
BIT (DISTMP,10) ;ONLY MEANINGFUL FOR DIS SYSTEMS
NOEXPO <
IFN FTDEBUG, <
BLOCK =18+=5 >
>;NOEXPO
BITDATA (FF WORD)
; FF (FLAG WORD) FLAGS
; LEFT HALF
?RELOC ←←400000 ;IF ON, CODE IS MADE RELOCATABLE
?RLCPOS←← 0 ;POSITION OF RELOC BIT IN FF
?TOPLEV←←200000 ;AT TOP (GLOBAL) LEVEL OF PROGRAM
?DEFLUK←←100000 ;DO NOT STACK RESULTS OF ID SCAN (IN STRING CONSTANT)
?IREGCT←← 40000 ;USED BY GBOUT (BINARY OUTPUT)
?FFTMP1←←IREGCT;SUPER-TEMP, NOT SAVED OVER ANYTHING
?PRMSCN←← 20000 ;STRING CONSTANT SCANNER SCANNING MACRO PARAM
?ERSEEN←← 10000 ;A SYNTAX ERROR IS SEEN -- NO MORE ERROR MESSGS.
?NOCRFW←← 4000 ;NO CREF NOW -- EXTERNAL PROCD. BEING DEFINED.
?BAKSCN←← 2000 ;THE SCANNER IS BACK ONE SYMBOL FOR ERROR
;RECOVERY. PARSE/SEMANTIC TOKENS ARE IN SAVPAR,SAVSEM
?PRODEF←← 1000 ;USED BY DECLARATION CODE TO SENSE AN IDLIST
?CREFSW←← 400 ;WE ARE CREFFING THIS LOSING FILE.
?NOMACR ←← 200 ;DO NOT EXPANT MACROS.
?LPPROG←← 100 ;LEAP FOREACH LIST IN PROGRESS
?PRMXXX←← 40 ;SPECIAL FLAG FOR SCANNER (MACRO PARAMS)
?ALLOCT←← 20 ;REALLY ALLOCATE WHEN CALLING TOTAL&ALOT
?FFTEMP←← 10 ;A REAL-LIVE TEMPORARY BIT!!
?MAINPG←← 4 ;THIS IS A MAIN (NOT PROCEDURE) PROGRAM
?BINARY←← 2 ;BINARY FILE OPEN
?LISTNG←← 1 ;LISTING FILE OPEN
↑ERSEEN←ERSEEN ;FOR UUO HANDLER.
; RIGHT HALF -- USED BY TOTAL (SEE MACRO GENMOV) FOR DIRECTIVE BITS.
BIT2DATA (SYMBOLIC SEMBLK INDICES)
?%TBUCK ←←0 ;BUCKET TIE IN FIRST WORD
?%TLINK ←←0 ;LINK TIE IN LEFT HALF OF FIRST WORD
?%STEMP ←←0 ;SAVE TTEMP IN PROCEDURE BLOCK (2D)
?$PNAME ←←1 ;PRINT NAME POINTER
?$DATA ←←1
?%SAVET ←←1 ;SAVE TTOP,,TPROC IN 2D PROCEDURE BLOCK
?$DATA2 ←←2
?$NPRMS ←←2 ;SAVE #STRING PARAMS,#OTHER PARAMS IN 2D PROC BLK
?$TBITS ←←3 ;TYPE BITS WORD
?$DATA3 ←←3
?$BLKLP ←←3 ;IN 2D PROC BLOCK, SAVE BLKLIM (LOWEST INDEX TO BLKLIS)
↑$PNAME ←←$PNAME ;STRING GARBAGE COLLECTOR HAS TO KNOW
?$SBITS ←←4 ;SEMANTIC BITS WORD
?$DATA4 ←←4
?$ADR ←←5 ;FIXUP ADDRESSES
?$ACNO ←←6 ;NUMBER OF DIMENSIONS, AC NUMBER
?$VAL ←←7 ;FIRST VALUE WORD
?$VAL2 ←←10 ;SECOND VALUE WORD
?%RVARB ←←11 ;VARB RING WORD
?%RSTR ←←12 ;STRING RING WORD
?BUKLEN←←=13 ;GOOD KIND OF NUMBER FOR BUCKET LENGTH
?BLKLEN←←=11 ;LENGTH OF SYMBOL TABLE BLOCKS
?STCNBK←← 1 ;IDENTIFIERS FOR VARIOUS BUCKETS
?CONBK ←← 2
?SYMBK ←← 3
NOTENX <
;INTERRUPT BITS
?INTPOV←←200000 ;RH BIT -- PDL OV - OBSOLETE BIT NOW
?IPOVIX←←=19 ;POV INDEX
NOEXPO <
?INTTTI←←4 ;LH BIT -- USER TYPED <ESC> I -- OBSOLETE BIT NOW
?ITTYIX←←=15 ;INDEX OF <ESC>I INTERRUPT
>;NOEXPO
>;NOTENX
TENX <
;INTERRUPT BITS
?IPOVIX←←=9 ;CHANNEL FOR PDL OV INTERRUPT
?ITTYIX←←5 ;CHANNEL FOR TENEX CONTROL-H INTERRUPT
>;TENX
;VARIOUS RUN-TIME DECLARATIONS. THESE PERTAIN TO THE
;CODE GENERATED.
; DON' TRY TO REDEFINE THESE --- IT TURNS OUT THAT A LOT DEPENDS ON
; THEM. (I.E. THE ABILITY TO CALL RUNTIME ROUTINES SUCH AS "CAT" AT
; COMPILE TIME).
ACDATA (RUN-TIME)
?RP ←←P ;RUN-TIME PUSH DOWN STACK.
?RSP ←←SP ;RUN-TIME SPECIAL STACK
?RTEMP ←←TEMP ;RUN-TIME SUPER-TEMP
ENDDATA
SUBTTL Externals, Data Allocation
;THESE ARE DECLARED EXTERNAL, AND WILL BE FOUND EITHER
;IN SECOND SEGMENT OR IN THE NON-REENTRANT PART LOADED WITH
;COMPILER.
EXTERNAL CONFIG,GOGTAB,RPGSW,CAT,PUTCH,POW,FPOW,%RENSW
EXTERNAL ALLPDP,%UUOLNK,%ALLOC,.SEG2.,CORGET,CORREL,CANINC,CAT,CVS
EXTERNAL SAVE,RESTR,STRGC,CORINC,JOBAPR,JOBCNI,JOBTPC
EXTERNAL %ARRSRT,SGREM ;FOR REMOVING %ARRSRT FROM LIST
EXTERNAL .ERRP.,%ERGO,%RECOV; FOR ERR UUO
EXTERNAL .ERBWD
PRINTX CHANGE HERE FOR DLOGS,DPOW
IFN 0,<EXTERNAL DLOGS,DPOW>
COMMENT ⊗
All SAIL data is allocated in one or the other of these two
blocks of storage. The ZERODATA and DATA commands serve to
place them here via the FAIL USE pseudo-ops. Tables of constants
are excepted.
⊗
?ZSIZE←←=775 ?DSIZE←←=1200
;last changed from zsize←←=750 on 4-3-75 jfr
;last changed from dsize←←=1150 on 10-16-76 jfr
IFN FTDEBUG, <
?ZSIZE←←ZSIZE+=32 ?DSIZE←←DSIZE+=30
>
TENX <
?ZSIZE←←ZSIZE+=300 ;MOSTLY FOR NAMES, A BLOCK OF 300
>;TENX
RENC <
;EXTRA SPACE IN IMPURE CODE, MOSTLY FOR RESERVED WORD TABLE
?ZSIZE←←ZSIZE+=100
?DSIZE←←DSIZE+=6100
TWOSEG 400000
>;RENC
?ZBASE: BLOCK ZSIZE ;ZEROED DATA (AT BEGINNING OF RUN)
SET ZVBLS,ZBASE ;2D PC
?DBASE: BLOCK DSIZE ;NON-ZEROED DATA
SET VBLS,DBASE ;3D PC
RENC <
SET LSEG,DBASE+DSIZE
RELOC 400000 ;UP TO PROGRAM SEGMENT
>;RENC
ZERODATA (MAIN-SEMANTICS POINTERS)
COMMENT ⊗
I. SYMBOL TABLE BLOCKS
The central data structure of SAIL is the symbol table, and related
objects. Each object in the symbol table is expressed as one or two
=11 word blocks, which will be called "Semblks," for "Semantics blocks,"
although they are not always used for semantics. These Semblks take the
following form --
⊗
DSCR SEMBLK structure -- typical
I.A Most Common Semblk Structure
0 %TLINK/%TBUCK lh "other pointer" [1]
rh "bucket pointer" [2]
1 $PNAME if this is a named entity, first word
or $DATA of string descriptor for it
2 <unnamed> second word of string descriptor
or $DATA2
3 $TBITS permanent data type bits for entity
or $DATA3 (INTEGER, EXTERNAL, VALUE, SAFE, etc.)
4 $SBITS temporary data type bits (ARTEMP, INUSE,
or $DATA4 SBSCRP, etc.)--low order 6 bits for lex. level
5 $ADR lh -- for strings, fixup chain addr for 2d
descriptor word
rh -- fixup chain addr or displacement
(param) for this variable
6 $ACNO rh -- accumulator number in which this
variable will be stored (at this PCNT)
7 $VAL for ARITH constants, the value
10 $VAL2 would be used for 2d words of DBLPRC and
CMPLEX constants
11 %RVARB VARB-ring pointers [3]
12 %RSTR STRING-ring pointers [4]
⊗
ZERODATA (MAIN-SEMANTICS POINTERS)
COMMENT ⊗
These indices and descriptions apply only to the most common uses of
these Semblks -- in particular, simple variables and constants. Many
others use many of the words in the same way (Procedure descriptors,
Array descriptors, etc.), but use others differently. Each such Semblk
will be called, simply, the "Semantics" of the thing it describes. Some
Semblks use the $DATA indices instead. Others use still other symbolic
or absolute indices. These divergent uses are described in the code
near the routines that handle them. See the list below, and the index
descriptions above for more information.
I.B Further explanations
Some of the entries (indicated by bracketed numbers, above, need more
explanation --
[1]%TLINK This pointer is empty (0) for simple variables. For Procedures,
it points to a second Semblk containing more information (which
second Semblk points to a parameter list). For Arrays, it points
to a Semblk describing the dimensions (see ARRAY). For Macros, it
points to the string const. Semantics representing the macro body. Etc.
[2]%TBUCK This pointer refers to the next symbol in the same hash bucket
(see SYMTAB, below)
[3]%RVARB This is used to tie a symbol to those declared with it.
It contains in its lh a pointer to the previous one, 0 if it
is the oldest; in rh it contains a pointer to the next (in order
of entry). This two-way pointer structure we (erroneously) call
a "Ring". One adds a Semblk to a Ring using one of several RNGxxx
routines at the end of SYM, whose parameters are the new Semblk.
One removes a Semblk via some URGxxx routines in the same area.
Most RINGing is done in ENTERS; most ULINKing in DONES
and ALOT. For local declarations, the Varb Ring links
Semantics of all identifiers declared in the same Block head. For
formal declarations, it ties together all the parameters of a
Procedure. VARB is usually the RING variable for %RVARB Rings.
Often, another pointer is kept for the old (left) end. Each
instance is described when its Semblk-type is completely described.
[4]%RSTR A Ring identical in form to the %RVARB Ring. Links all Semblks
with non-constant string descriptors in them for STRNGC. STRRNG is
the RING variable for %RSTR. Thus STRNGC traverses it rt. to left.
I.C Other Common Semblk Usages
These Semblks are used in a few applications as other than
Semantics. Here are the most common ones --
I.C.1 Buckets.
The symbol table is accessed associatively via these bucket Semblks. Each
contains pointers to 20 buckets (pointer chains, linked through %TBUCK).
There are hashing functions in ENTERS to select, for any variable name,
(or arithmetic value), the proper bucket chain during LOOKUP operations.
There are three completely independent bucket Semblks; SYMTAB points to
the one for identifiers, STRCON to the one for string constants,
and CONST to that for arithmetic variables.
The rh of the last word of the Semblk (SYMTAB only) points to a previous
bucket Semblk (see SYMTAB).
I.C.2 Qstacks
There are stack-like applications in the compiler, where the maximum
size of the stack may vary greatly from compilation to ditto.
Therefore a kind of stack called a Qstack was implemented. Each
Qstack is a list of these Semblks, with the forward/backward links
in the first word of each, data in the rest. The macros QPUSH,
QPOP, QTAK, QBACK, QBEGIN and QFLUSH are used to operate on the
stacks. Each takes as at least one argument a pointer to a "Qstack-
Descriptor", whose lh is a pointer to the current top of stack, and whose
rh is a pointer to the Semblk containing the top. See QPUSH, etc. for
calling sequences, the BPUSH, etc. routines for more detailed descriptions.
Many of the stack descriptors are declared just below; the rest are found
near the code which uses them.
I.D Semblk Allocation
The GETBLK macro calls a routine to get the address of a free Semblk
into LPSA. The FREBLK macro is used to return a Semblk to free storage.
II. SEMANTICS VARIABLES
These variables (or tables) contain pointers to Semblks. They form
the base for the SAIL data structures.
⊗
COMMENT ⊗
ACKTAB -- Each entry is either 0 (nothing in this AC) or --
rh -- ptr to Semantics of something which can reside in an AC
(arith, pointer to Array elt., pointer to string dscr, etc.)
This means that the code currently being generated has
loaded the AC with the indicated entity, and can refer
to it there. If the Semantics is a variable (named), a copy
will also exist in core. Otherwise it is a temp value found
only in the AC.
The $SBITS entry of the Semantics will have the INAC bit on,
or there is a mistake. Also, the $ACNO entry will contain the
number of this AC. This table provides a useful redundancy.
lh -- If 0, this AC can be released for another use (by clearing the
table entry, modifying the $SBITS word of its Semantics, and
issuing instructions to store the value in core, if necessary.
If -1, this AC is being protected. Its Semantics cannot be
changed until it is explicitly unprotected.
The GETAC routine is called to obtain a free AC number. It uses
this table. The table is also used when it is desired to free
all AC's (before calling a Procedure, jumping to a label, etc.)
⊗
?ACKTAB: BLOCK 20 ;THE ACCUMULATOR TABLE
;ADRTAB -- RING variable or a VARB-Ring of address constant
; Semantics (see ADCINS, MAKADR, ADCGO)
?ADRTAB: 0
COMMENT ⊗
BLKIDX -- QSTACK DESCR -- each entry in this qstack (we'll call it
BLKLIS) is a completed VARB-Ring for a Block -- stack entry is
ptr to oldest entry, a "Block-Semblk". These lists are transferred
here when the ENDs for the Blocks are seen. ALOT, which allocates
variables, uses these lists (at termination of a Procedure). See
DOSYM for the reason for doing it this way.
⊗
?BLKIDX: 0 ;QSTACK for completed VARB RINGS
?CONINT: 0 ;VARB-Ring linking all arithmetic constants
?CONST: 0 ;ptr to bucket Semblk for arithmetic constants
?CONSTR: 0 ;VARB-Ring linking all string constants
?DEFRNG: 0 ;VARB-ring (old end) of current macro actual params
; GENLEF, GENRIG -- although these tables usually contain Semantics,
; they are described below with the PARSER structures.
; LPSBOT, LPSTOP -- they define the boundaries of the last-allocated
; symbol table (Semblk) area
?LPSBOT: 0 ;Address of first word of first Semblk
?LPSTOP: 0 ;Address of first word not in Semblk area
COMMENT ⊗
MBLK is the 2d Procedure Semblk (see PROCED) for a dummy outer Procedure
(initially titled "M", later changed to the program name, if there is one)
which is assembled into the compiler. This Procedure descriptor, labeled
IPROC (placed in PARSE by the RTRAN program) forms the base for SAIL'S
lexic. structure. One non-standard feature of this descriptor is the
VARB-Ring growing out of its lh %RVARB pointer. This Ring links all
the assembled-in runtime Procedure Semantics (INPUT, EQU, etc.). The MBLK
thing is set up as the second Semblk for IPROC at SALNIT time--since most
code treats this Semblk as a regular Procedure, and access words in this
second Semblk.
⊗
?MBLK: BLOCK BLKLEN
;NEWSYM--SCANNER returns Semantics of lookup here--see SCANNER globals below
;;#GP# DCS 2-6-72 (1-4) CHECK FORWARD FORMALS AGAINST REAL FORMALS
;OLDPRM--Saves the Formal list from a FORWARD Procedure declaration during
; the scanning of the formals of the actual (or another FORWARD) proc dec.
?OLDPRM: 0 ;OLD FORMAL LIST STORED HERE
;;#GP# (1)
;;#SD# IEFLAG -- set ≠0 if external procedure redeclared as internal
?IEFLAG: 0
?STRCON: 0 ;VARB-RING FOR STRING CONSTANTS
?STRRNG: 0 ;LINKS ALL SEMBLKS WITH NON-CONST STRINGS (FOR GC)
COMMENT ⊗
SYMTAB -- points to current identifier bucket Semblk. A new copy is made at
each new Block entry, and linked as described above (see Buckets). At Block
exit the previous old one is restored. Since new entries are added at the
beginnings of bucket lists, this "pop" operation restores the old scope of
variables at Block exit. The first SYMTAB Semblk is copied from one
which is assembled in via the RTRAN program, and provides (hashed)
access to all reserved words and built-in Procedures.
⊗
?SYMTAB: 0
COMMENT ⊗
TPROC -- points to Semantics of Proc. being compiled (originally initialized
to point at IPROC (see MBLK above). When a new Procedure name is seen, the
previous TPROC and TTOP pointers are saved in its Semantics. Both
are then set to point at the new Semantics. TPROC, TTOP, and their saved
previous values, are used with VARB to keep track of the lexic. structure;
on Block and Procedure exits, values are restored as the VARB-Rings being
removed from the structure are transferred to the BLKLIS via BLKIDX(above).
⊗
?TPROC: 0
COMMENT ⊗
TTEMP -- a VARB-Ring of all the temp-Semantics currently allocated by this
Procedure -- temps represent things in ACs, in the string stack, and in
specially-allocated temp core addresses (depending on their $SBITS). Each
Procedure has its own set of temps. See GETTMP for more information
about the format of temp-Semantics. The TTEMP pointer is saved in the old
TPROC Semantics when new Procedure declaration is recursively encountered.
It is then reset. Restoration occurs as Procedure declarations are
completed. It is for this and similar reasons that the top of the data
structure is a faked Procedure (IPROC), e.g., so that the Procedure-exit
code can be used to allocate the outer-Block variables.
⊗
?TTEMP: 0
COMMENT ⊗
TTOP -- points to Semantics of Block being compiled, thus to oldest end
of VARB-Ring for this Block, since the Block Semantics is the first on
the VARB-ring for a given Block. VARB (below) points to the other end
of the same Ring. TTOP is saved in new Block Semantics before being
reset to point to them. VARB is saved in there also, then reset to 0.
TTOP is also saved in Procedure Semantics as described above. This allows
restoration of the lexic. structure.
⊗
?TTOP: 0
COMMENT ⊗
VARB -- the RING variable for the current VARB-Ring of identifiers local
to the Block being compiled (usually). TTOP points to the new end
of the same ring. VARB is used to add new entries (see ENTERS routine)
as declarations are encountered. It is also used to link Procedure and
Macro parameters (various uses never conflict due to judicious saving).
⊗
?VARB: 0
ZERODATA(DISPLAY REGISTER HANDLING VARIABLES)
?SIMPSW: 0 ;SET TO ≠0 IF COMPILING A SIMPLE PROCEDURE
?CDLEV: 0
COMMENT ⊗
CDLEV -- the current display level. Gets bumped by one for each time
a new procedure declaration is entered and gets dropped by one at the
end of each such declaration.
⊗
?DISTAB: BLOCK 20
COMMENT ⊗
DISTAB -- table of display registers.
lh(DISTAB(lev)) is ac number containing rS at time of proc call
rh(DISTAB(lev)) is ac number which points at the base of the
appropriate mark stack control packet.
⊗
?DISLST:0
COMMENT ⊗
DISLST-- owns varb ring of display temps, which exist solely for the
benefit of ACKTAB
⊗
?RECSW: 0 ;SET ≠0 WHEN WE ARE COMPILING A RECURSIVE PROCEDURE
?SSDIS: 0 ;STRING STACK DISPLACEMENT -- USED BY ALLOCATION & FRIENDS
?ASDIS: 0 ;SAME FOR ARITH STACK
?CSPOS: 0 ;NICE LOCAL FOR ALLOCATION
BITDATA(DISPLAY STUFF)
?LLFLDL ←←6 ;SIZE OF LEX LEVEL FIELD IN SBITS
?DLFLDL ←←4 ;DITTO DISPLAY LEVEL
?DLFLDM ← (1⊗DLFLDL-1)⊗LLFLDL ;MASK FOR FIELD
?LLFLDM ← 1⊗LLFLDL-1
?STACKV←DLFLDM ;FIELD ≠0 IFF VAR GOES TO STACKS (MAY BE A LIE FOR TEMPS)
ZERODATA (MAIN-SCANNER VARIABLES)
COMMENT ⊗
PNAME -- this is a string descriptor, set up by SCANNER whenever it scans
an identifier or string constant. It is used by ENTERS to provide the
print name of the identifier (value of the constant). It is linked to
the string garbage collector via standard string link blocks (see STRNGC
routine, SALNK below).
⊗
?PNAME: 0 ;XWD STRING NUM,LENGTH
0 ;BYTE POINTER
COMMENT ⊗
BITS -- As declarators (INTEGER, STRING, EXTERNAL, etc.) are encountered,
the $TBITS bits corresponding to them are ORed into BITS (see TYPSET rout
and friends). These bits are used by ENTERS to set up the $TBITS word
of newly entered identifiers and constants. BITS is set up explicitly
by some EXECS when they wish to create constants (stack-adjustors,
results of constant expressions, etc.)
⊗
?BITS: 0
?SCNVAL: 0 ;VALUE OF LAST ARITHMETIC CONSTANT SCANNED
?DBLVAL: 0 ;UNUSED-WLD BE VALUE OF 2D WD-COMPLX AND DBLPRC CONSTS
;DEFRNG -- see Semantics variables above
COMMENT ⊗
NEWSYM -- SCANNER always returns 0 (not found) or found Semantics
whenever it scans an identifier. ENTERS always stores the Semantics
of each new symbol it enters.
⊗
?NEWSYM: 0
DATA (MAIN-SCANNER VARIABLES)
;DEFPDP, DFSTRT -- PDP and base address for special DEFINE push down list
; see code in SYM (SCANNER) for its format
↑↑DFSTRT:0 ;ADDRESS OF STACK BASE
↑↑DEFPDP: 0 ;DEFINE STACK PDP
;SCNWRD -- bits describing state of SCANNER (expand macros, listing,
; print PC, print line #, etc.)--usually transferred to TBITS2 AC
; when in use. Other SCANNER control bits found in FF AC.
?SCNWRD: 0
;;%DF% !
?FMTWRD: 0 ;SWITCH SCANNER PLACES FORMAT (/F) BITS HERE
;CURRENTLY, ONLY USED FOR CHECK ON 100 BIT
?SPRBTS: 0 ;ACCUMULATE BITS FOR CHECK!TYPE FEATURE
COMMENT ⊗ Other variables which would seem to be in the domain of the SCANNER
will be found in one of the SOURCE FILE VARIABLES areas; sometimes because
they seemed more important to the I/O side than to the scanning itself;
sometimes because they must be saved as a group with other variables when
source files are switched via the REQUIRE ... SOURCE!FILE construct.
⊗
ZERODATA (MAIN-PARSER VARIABLES)
COMMENT ⊗
GENLEF, GENRIG -- assumed is an understanding of the theory and operation
of the parser. Semantics pointers are put on the semantics stack (synched
with the parse stack). If a production matches the top of the parse stack,
the top Semantics ptr is popped into GENLEF, the next into GENLEF+1, etc.
up to the number of elements on the left side of the production. Then the
EXEC routines are called. These EXEC routines place appropriate Semantics
in GENRIG, GENRIG+1, etc. corresponding to the new top, next. etc. stack
elements. Unchanged Semantics are filled in by the parser. Thus all
communication between PARSER and EXECS is accomplished via these variables.
See PARLEF, PARRIG, GPSAV, PPSAV for related variables.
⊗
TEMLEN←←10 ;LENGTH OF THESE TABLES
?GENLEF: BLOCK TEMLEN ;INPUTS TO EXECS
?GENRIG: BLOCK TEMLEN ;OUTPUTS FROM EXECS
COMMENT ⊗
PARLEF, PARRIG -- same function as GENLEF, etc. for parse stack (integer
tokens for terminal and non-terminal symbol. EXECS on rare occasions
modify the PARRIG elements, but they are mainly used for making stack
adjustments easy for the PARSER.
⊗
?PARLEF: BLOCK TEMLEN ;LEFT SIDE PARSE STACK TEMPS
?PARRIG: BLOCK TEMLEN ;RIGHT SIDE DITTO
DATA (MAIN-PARSER VARIABLES)
↑↑GPSAV: 0 ; SEMANTICS (GENERATOR) PDP STORED HERE WHEN UNUSED
↑↑PPSAV: 0 ; PARSE STACK PDP STORED HERE WHEN UNUSED
?PCSAV: 0 ; CURRENT PRODUCTION CONTROL STACK POINTER
?SCWSV: 0 ; CURRENT SCANWORD STACK POINTER
?SCNNO: 1 ; CURRENT REMAINING NUMBER OF CALLS TO SCANNER
?SGPSAV: 0 ; SAIL SEMANTIC STACK POINTER
?SPPSAV: 0 ; SAIL PARSE STACK POINTER
?SPCSAV: 0 ; SAIL PRODUCTION CONTROL STACK POINTER
?SSCWSV: 0 ; SAIL SCANWORD STACK POINTER
?CGPSAV: 0 ; CONDITIONAL ASSEMBLY SEMANTIC STACK POINTER
?CPPSAV: 0 ; CONDITIONAL ASSEMBLY PARSE STACK POINTER
?CPCSAV: 0 ; COND. ASS. PRODUCTION CONTROL STACK POINTER
?CSCWSV: 0 ; COND. ASS. SCANWORD STACK POINTER
;#SN# (1 OF 8) RLS 1-1-75 MAKE EXPR!TYPE RECURSIVE
?EXPSPT: 0 ; EXPR!TYPE STACK POINTER
?PRSCON: 0 ; PARSER INITIALLY IN CONTROL - I.E.
; PRSCON=0 INDICATES SAIL IN CONTROL
; PRSCON=-1 INDICATES COND. ASS. IN CONTROL
TABCONDATA (SPACE-ALLOCATION DEFAULT SPECIFICATIONS)
; See GOGOL (%ALLOC) for the meaning of all the numbers
; The standard defaults can be changed by compiler switches (/P, etc.)
CONSIZ←←=30
IMSSS<PSSKSZ←←=128>
NOIMSSS<PSSKSZ←←=64>
IMSSS<DFSKSZ←←=160>
NOIMSSS<DFSKSZ←←=40>
;#SN# (2 OF 8) MAKE EXPR!TYPE RECURSIVE
IMSSS<EXSKSZ←←=1000>
NOIMSSS<EXSKSZ←←=100>
DEFSIZ: XWD STDSPC!SYSPD,=64 ;P-STACK
XWD STDSPC!SYSSPD,=16 ;SP-STACK
XWD STDSPC!STRSP,=3500 ;STRING SPACE
XWD WNTPDL,PSSKSZ ;PARSE STACK
XWD [ASCIZ/SYNTAX STACK/],PPSAV
XWD WNTPDL,PSSKSZ ;SEMANTICS STACK
XWD [ASCIZ/SEMANTICS STACK/],GPSAV
XWD WNTPDL,PSSKSZ ;PRODUCTION CONTROL STACK
XWD 0,PCSAV
XWD WNTPDL,CONSIZ ;CONDITIONAL PROD. CONTROL STACK
XWD 0,CPCSAV
XWD WNTPDL,CONSIZ ;CONDITIONAL SEMANTICS STACK
XWD 0,CGPSAV
XWD WNTPDL,CONSIZ ;CONDITIONAL PARSER STACK
XWD 0,CPPSAV
XWD WNTPDL,CONSIZ ;SAIL SCANWORD STACK
XWD 0,SCWSV
XWD WNTPDL,CONSIZ ;CONDITIONAL PARSER SCANWORD STACK
XWD 0,CSCWSV
XWD WNTADR!WNTPDL,DFSKSZ ;DEFINE STACK
XWD [ASCIZ/DEFINE STACK/],DFSTRT
;#SN# (3 OF 8) RLS 1-1-75 MAKE EXPR!TYPE RECURSIVE
XWD WNTPDL,EXSKSZ
XWD 0,EXPSPT
;#SN#
XWD WNTADR!WNTEND,=2200 ;SYMBOL TABLE SPACE
XWD 0,LPSBOT
0 ;END IT ALL
ZERODATA (SPACE-ALLOCATION REQUEST BLOCK)
; See GOGOL (%ALLOC) for format and use of these things
SPREQ: BLOCK $SPREQ ;STANDARD SIZED BLOCK FOR LEAP GARBAGE
PDLMAX: 0 ;SIZE OF SYSTEM!PDL
SPMAX: 0 ;SIZE OF STRING!PDL
STMAXX: 0 ;SIZE OF STRING!SPACE
PPMAX: BLOCK 2 ;SIZE AND POINTER ADDRESS OF PARSE STACK
GPMAX: BLOCK 2 ;" OF GENERATOR STACK (SHOULD = PPMAX)
PCMAX: BLOCK 2 ;SEE ABOVE
CPCMAX: BLOCK 2
CGPMAX: BLOCK 2
CPPMAX: BLOCK 2
SCWMAX: BLOCK 2
CSCMAX: BLOCK 2
DFMAX: BLOCK 2 ;SIZE AND POINTER ADDRESS FOR DEFINE STACK
;#SN# (4 OF 8) MAKE EXPR!TYPE RECURSIVE
EXMAX: BLOCK 2 ;SIZE AND POINTER ADDRESS FOR EXPR!TYPE STACK
LPSMAX: BLOCK 2 ;SIZE AND POINTER ADDRESS FOR SYMBOL TABLE SPACE
0 ;NO MORE
SPREND←←.-1
LINK 2,SPREQ ;PROVIDE THE LINK
ZERODATA (CONDITIONAL-PARSER VARIABLES)
?SWCPRS: 0 ; SWITCH PARSER FLAG
?DLMSTG: 0 ; POSSIBLY LOOKING FOR SPECIALLY DELIMITED STRINGS
; FLAG. THESE STRINGS INCLUDE MACRO BODIES AND
; BODIES OF CONDITIONAL COMPILATION WHILEC, CASEC,
; FORC, OR FORLC STATEMENTS.
?NODFSW: 0 ; FLAG TO DEFER PROCESSING OF DEFINES AFTER A BEGIN UNTIL
; A BLOCK HAS BEEN EXECUTED.
?REDEFN: 0 ; REDEFINE IN PROGRESS FLAG
?EVLDEF: 0 ; EVALDEFINE IN PROGRESS FLAG
?ASGFLG: 0 ; ASSIGNC IN PROGRESS FLAG
DATA (CONDITIONAL-PARSER VARIABLES)
COMMENT ⊗
RESLOC is a table containing for each parser interrupt trigger e
reserved word the following information. The left half contains
a set of flags which must be turned on in the left half of the
$TBITS entry of the reserved word and the length of the reserved
word. The right half contains the address of a byte pointer to
the string.
⊗
?CONRES←←200000 ; COND. ASS. RESERVED WORD FLAG IN LEFT HALF OF $TBITS
?DEFINT←←100000 ; INDICATES PARSER INTERRUPT AND A PUSHJ TO A
; PRODUCTION WITHOUT SWITCHING PARSERS
?CONDIN←←40000 ; INDICATES A PARSER INTERRUPT AND A PUSHJ TO A
; PRODUCTION IN THE CONDITIONAL PARSER
?CONBTS←←CONRES+DEFINT+CONDIN ; BITS THAT ARE ON IN $TBITS OF A PARSER
; INTERRUPT TRIGGER RESERVED WORD
?NMCRES←←=14 ; NUMBER OF PARSER INTERRUPT TRIGGER RESERVED WORDS
?IF0OFF←1000 ; DESIGNATES THE RIGHTMOST BIT OF THE LEFT HALF OF
; $TBITS OF A PARSER INTERRUPT TRIGGER RESERVED
; WORD WHICH CONTAINS AN INDEX INTO A TABLE
; STARTING AT PRODGO IN PARSE OF THE PRODUCTIONS TO
; WHICH ONE IS PUSHJ'ING.
?IF0SHF←←=9 ; NUMBER OF BITS ONE MUST SHIFT LEFT IN ORDER TO
; UNPACK PARSER INTERRUPT INDEX FROM $TBITS OF
; THE RESERVED WORD
?RESLOC: XWD CONRES+CONDIN+3,[ASCII/IFC/]
XWD CONRES+5,[ASCII/ELSEC/]
XWD CONRES+4,[ASCII/ENDC/]
XWD CONRES+CONDIN+6,[ASCII/WHILEC/]
XWD CONRES+CONDIN+5,[ASCII/CASEC/]
XWD CONRES+CONDIN+4,[ASCII/FORC/]
XWD CONRES+CONDIN+5,[ASCII/FORLC/]
XWD CONRES+DEFINT+6,[ASCII/DEFINE/]
XWD CONRES+CONDIN+4,[ASCII/IFCR/]
XWD CONRES+DEFINT+10,[ASCII/REDEFINE/]
XWD CONRES+DEFINT+12,[ASCII/EVALDEFINE/]
XWD CONRES+DEFINT+7,[ASCII/ASSIGNC/]
XWD CONRES+DEFINT+5,[ASCII/NOMAC/]
XWD CONRES+DEFINT+14,[ASCII/EVALREDEFINE/]
COMMENT ⊗
%CTRUE and %CFALS are the locations containing the tokens required
by TWCOND which checks the value of the compilation condition
⊗
ZERODATA (MAIN-SOURCE AND LISTING FILE VARIABLES)
COMMENT ⊗
IPLINE -- BP to first word of file input line; used only by PARSE/DEBUG
guy when scanning a macro (PLINE normally points here too, when not
expanding macro). Used to print original input line when an error is
detected (see also COMSER&DSPLIN).
⊗
↑↑IPLINE: 0
?PGSIZ←←=50 ;# LINES/PAGE ON LISTING
CMU <
?PGSIZ ←← PGSIZ+5 ;CMU HAS A BETTER??? LPT SERVER
>;CMU
;SRCDLY -- this is a flag used to signal the command scanner and end of
; file code that a source-file switch is happening (via the
; REQUIRE .... SOURCE!FILE stuff).
?SRCDLY: 0
↑↑CRIND:0 ;SET IF CRLF/INDENT SEQUENCE NEEDED BEFORE NUMBER
DATA (MAIN-SOURCE AND LIST FILE VARIABLES)
;ASCLIN -- ascii value of line number for current input line, if file
; has line numbers
↑↑ASCLIN: 0
BYTE (7) 11 ;TAB FOR LIST OUTPUT AFTER LINE NO.
;LSTSTRT -- set by /nL in command line to provide an offset for
↑↑LSTSTRT: 0 ;display of PC in listing.
NOTENX <
COMMENT ⊗ The address of the Stanford UINBF UUO points to a two-word block--
1 -- # buffers wanted
2 -- size of each buffer.
This functions identically to the INBUF UUO, except that the size of the
buffer is specified exactly. In the NOEXPO system, the size for the source
file is always chosen 1 bigger than needed for the largest buffer provided by
any device. The last word is always set 0 by SCANNER. This serves as a flag
to the SCANNER that a buffer is ended -- an efficiency measure. Therefore,
in the EXPO version, this is simulated. UINBF takes in AC TEMP a pointer
to a UINBF block, and allocates the buffers. (changes AC C)
⊗
EXPO <
UINBF: ADD B,[XWD 400000,1] ;NOT USED BIT,PTR TO 2D WORD FIRST BUFFER
PUSH P,B ;SAVE PTR TO BUFFER
MOVEM B,SRCHDR ;PUT PTR IN BUFFER
HRL C,1(TEMP) ;SIZE DESIRED
MOVE TEMP,(TEMP) ;#BUFFERS
UINBL: SETZM -1(B) ;CLEAR BOOKKEEPING WORD
HLRS C ;SIZE,,SIZE
ADDI C,2(B) ;PTR TO 2D WORD NEXT BUFFER
MOVEM C,(B) ;2D WORD THIS BUFFER
HRRZI B,(C) ;PTR TO NEXT BUFFER
SOJG TEMP,UINBL ;DO ALL OF THEM
POP P,TEMP ;PTR TO 2D WORD OF FIRST
HLRZS C
SUB B,C
HRRM TEMP,-2(B) ;LAST PNTS TO FIRST
HRRZI B,-1(TEMP) ;PTR TO 1ST WORD OF BUFFERS
POPJ P, ;DONE
>;EXPO
>;NOTENX
DATA (SWITCHED VARIABLES)
COMMENT ⊗
This area contains all data necessary to describe the state of
a given source file (channel, io buffers, etc.). It is grouped
together in order that it might be saved as a group, when the
SCANNER switches temporarily to another source file, via the
REQUIRE ... SOURCE!FILE construct. The saved groups are stored
in CORGET areas allocated for the purpose.
The first data is the source file CDB (see MAKCDB for detailed
description). It contains Device, File name, IO buffer headers,
and instructions tailored for use when accessing this file (these
instructions are XCTed during the OPEN sequence for the file.
As the MAKCDB macro will show you, labels are generated for access
to the various parts of the CDB (channel data block).
⊗
TENX<
?BGNSWA:
>;TENX
NOTENX <
MAKCDB (SRC,SRC,0,=8,0)
COMMENT ⊗
Some more instructions to be XCTed. These instructions are interpreted
only for the source file, since this is the only case where the channel
number might change. The proper channel # is deposited in the AC field
of the instructions during SAIL initialization, and when switching source
files.
⊗
?INSRC: INPUT SRC,0 ;XCT TO DO INPUT
?EOFSRC: STATZ SRC,20000 ;TEST EOF
?RELSRC: RELEASE SRC,0 ;TO RELEASE FILE
?TSTSRC: TSTERR (SRC) ;TO TEST ERRORS
COMMENT ⊗
The command scanner (which reads compilation specs) always stores the
requested file names, extensions, etc., in sixbit, into the following
data block. These are used by the command scanner to open input/output
files. They are also used by other routines (which call FILNAM in the
command scanner to set them up) to convert strings specifying file names
to this sixbit format (REQUIRE ... LOAD!MODULE, for example).
⊗
?DEVICE: 0 ;DEVICE NAME IN SIXBIT
?NAME: 0 ;FILE NAME
EXTEN: 0 ;EXTENSION IN LH, RH UNUSED
WORD3: 0 ;WORD 3 OF LOOKUP/ENTER BLOCKS, ALWAYS ZEROED
;(AT THE SAME TIME HLLZS EXTEN)
?PPN: 0 ;SPECIFIED PPN, OR 0 FOR USER DEFAULT
0 ;FOR SWAP UUO?
;;#%%# BY JFR 11-7-74 PPN NOW KEPT IN CDB
;↑SRCPPN: 0 ;PPN IN SIXBIT, SAVED FROM SOURCE FILE SPEC
;;=I10= ADD SFD'S
SFDS<
?PATHB: BLOCK 4+SFDLVL ;PLACE FOR PATH, IF ANY
> ;SFDS
TYMSHR <
TYMUSR: BLOCK 2
>;TYMSHR
; HERE ARE SOME CONTROL VARIABLES FOR THE COMMAND SCANNER
EOF: 0 ;END OF FILE HAS BEEN SEEN ON COMMAND FILE
?EOL: 0 ;END OF LINE HAS BEEN SEEN IN COMMAND FILE
NOFILE: 0 ;NO FILE NAME WAS SEEN BY FILNAM ROUTINE
?SAVTYI: 0 ;ONE-CHAR LOOKAHEAD SOMETIMES NEEDED IN COMND
; HERE ARE SOME CONTROL VARIABLES FOR THE SOURCE-SWITCHING FEATURE
COMMENT ⊗
AVLSRC -- bit 0 for channel 0, bit 1 for channel 1, etc.
contains a 1-bit for every channel which is now available as a
source file channel. Since this is saved with the rest, a channel
is automatically returned to the land of the free when this data
is BLTed back during unswitching.
⊗
;; %BC% ADD BAIL SYMBOL OUTPUTING
NOBAIL <
?AVLSRC: XWD 007774,0 ;CHANNELS 6 AND ABOVE AVAILABLE (INITIALLY)
>; NOBAIL
BAIL <
?AVLSRC: XWD 003774,0 ;CHANNELS 7 AND ABOVE AVAILABLE ( INITIALLY)
>;BAIL
;; %BC%
>;NOTENX
TENX <
?SRCFLN: BLOCK =30 ;USED FOR THE FILE NAME, SET UP IN CC, USED IN CC, COMSER
?SRCJFN: 0
?SRCPNT: 0
?TTYSRC: 0 ;TRUE IF THIS SOURCE IS THE CONTROLLING TERMINAL
?TNXBND: 0 ;POINTER TO END OF BUFFER FOR ADVBUF
>;TENX
;BUFADR -- CORGET pointer to IO buffers for this source file
BUFADR: 0
;SWTLNK -- CORGET pointer to saved data for higher-level file (0 if outer)
↑SWTLNK: 0
COMMENT ⊗ These variables are cleared (independently of the main
cleared area) at SAIL initialization and whenever file switching
occurs.
⊗
SLD1: ;BEGINNING OF SWITCHED-CLEARED AREA
COMMENT ⊗
PNEXTC -- this is the byte pointer used by the SCANNER for its input.
It is saved, restored, and massaged all over the place. It takes
the form of the 2d word of a string descriptor, so that the garbage
collector can alter it, if it represents a pointer into a macro body
in string space.
⊗
0 ;USED BY STRINGC
?PNEXTC: 0 ;BYTE POINTER FOR SCANNER INPUT
;PLINE -- BP (also string descriptor) to beginning of current input line
; IPLINE always saves PLINE for input file -- PLINE may pnt into a macro.
0 ;ALSO FOR STRINGC
?PLINE: 0 ;BYTE POINTER FOR BEGINNING OF "LINE"
;SAVCHR -- when an identifier is scanned, one extra character is sometimes
; read before end of identifier is determined. SCANNER always checks
; this variable for the extra character before reading any more.
?SAVCHR: 0 ;ONE-CHAR LOOKAHEAD FOR SCANNER
BAIL<
COMMENT ⊗
BPNXTC -- byte pointer and flag used by debugger. Set to zero to request
that the place in the input or listing file be remembered at the next
token. If non-zero, then a byte pointer to the place remembered.
Currently zeroed whenever a BEGIN, semicolon, or ELSE is found.
Necessary because we must remember the place at the beginning of a
statement but don't know whether or not we actually need a new
coordinate until the end of the statement.
⊗
?BPNXTC: 0 ;DEBUGGER BYTE POINTER
>;BAIL
; SOME FILE PARAMETERS FOR LISTING AND ERROR MESSAGE OUTPUT
?FPAGNO: 0 ;PAGE NUMBER WITHIN THIS FILE
↑↑FPAGNO←FPAGNO ;..
?PAGENO: 0 ;CURRENT LOGICAL PAGE NUMBER
?PAGINC: 0 ;PHYSICAL PAGE NO. WITHIN THIS LOGICAL PAGE
?BINLIN: 0 ;SEQUENTIAL LINE NUMBER WITHIN LOGICAL PAGE
↑↑BINLIN←BINLIN
;;#HU# ! 6-20-72 DCS BETTER TTY LISTING
↑LININD: 0 ;#LEVELS TO INDENT TTY LISTING
ENDSRC←←.-1 ;END OF CLEARED AREA -- END OF SWITCHED AREA
;;%CF% 2! JFR 7-8-75
POINT 7,.+1 ;SAIL STRING DESCRIPTOR TO STRING OF BLANKS
ASCII / /
TENX<
;BUFFER FOR LOADER-EDITOR COMMUNICATION
;This is tenex specific because RS wanted the flexibility
ZERODATA (TMPCOR BUFFER)
?TMPCBF: BLOCK 40
>;TENX
ZERODATA (GLOBAL STATE VARIABLES)
COMMENT ⊗
LEVEL -- starts at 0, has 1 added for each Block, named Compound Statement
and Procedure declaration encountered. Decremented when corresponding
END or termination of Procedure body is processed. This number is stored
in $SBITS of each identifier declared at this level. It is used in
resolving questions of scope (to determine if a declaration is a duplicate,
if a label can be "gone to", etc.)
⊗
?LEVEL: 0
COMMENT ⊗
NMLVL -- incremented when Procedure declaration or NAMED Block or Compound
Statement is seen -- decremented on termination. NMLVL is the DDT level
of a variable. It is stored only in the Block (Procedure) Semantics at
this level. It is placed in the level field of a Block-name loader output
block for DDT -- also used to determine the order of output of symbols
to DDT
⊗
?NMLVL: 0
COMMENT ⊗
PCNT -- initialized to zero, one is added for each word of code or data
generated. This is the (relative) program counter, and is used to format
the REL file output.
If the program is being compiled into two segments, two PCNT variables
are needed, one for the data (low, impure) and one for the code
(high, pure). HCNT holds the current value of the "other" counter
when the "other's other" is in use.
HISW -- On if /H was typed to indicate a two-segment (re-entrent)
compilation.
INHIGH -- Irrelevant unless HISW on -- determines whether PCNT represents
second segment addresses, and HCNT the low ones (ON), or vice versa.
⊗
?PCNT: 0
REN <
?HCNT: 0
?HISW: 0
?INHIGH:0
>;REN
ZERODATA (COUNTER SYSTEM VARIABLES)
COMMENT ⊗
KOUNT -- set to non-zero by the presence of a /K switch.
Indicates that counters are to be inserted into all loops.
For each counter inserted, a marker ('177&'02") is inserted
into the listing file. For counters in conditional and case
expressions, a different marker ('177&'03) is inserted.
⊗
?KOUNT: 0
COMMENT ⊗
KCOUNT -- starts at zero, incremented with each counter inserted.
Its final value is compiled into the object code and is used by
K.FIX and K.OUT to determine how many counters there are.
⊗
?KCOUNT: 0
COMMENT ⊗
KPDP -- a QSTACK is used to hold the address of each AOS instruction
that increments a counter. At the end of the compilation, after
the block of counters is allocated, these locations are fixed up
to point to the proper counter.
⊗
?KPDP: 0
DATA (RANDOM GLOBAL THINGS)
; String link blocks (for STRNGC) for PNAME, PNEXTC, PLINE
SALSTR: 1 ;FOR STRING GC -- BLOCK ALWAYS ACTIVE
XWD 2,PNEXTC-1 ;PNEXTC AND PLINE
SALNK: 0 ;LINK THROUGH HERE VIA
LINK 1,SALNK ; LINK #1
1
XWD 1,PNAME ;FOR PNAME
SALK1: 0 ;LINK THROUGH HERE ALSO
LINK 1,SALK1
;PLEVEL -- byte pointer to access level field in $SBITS of semantics pointed
; to by AC LPSA
?PLEVEL: POINT LLFLDL,$SBITS(LPSA),35 ;LEXICOGRAPHIC LEVEL
?STPSAV: 0 ;STRING PDP STORED HERE WHEN UNUSED
; Stack-adjusting values
?X11: XWD 1,1
?X22: XWD 2,2
?X33: XWD 3,3
?X44: XWD 4,4
↑X11←X11
↑X22←X22
↑X33←X33
↑X44←X44
;;%CF% JFR 7-8-75
IFN 0,<
↑↑INDTAB:0 ;INDENTING SPACES
ASCIZ / / ;LEVEL 1
ASCIZ / /;LEVEL 2
ASCIZ / /; L 3
ASCIZ / /;4
0 ;SAFETY
>
;;%CF% ↑
BAIL<
BITDATA (DEBUGGER REQUEST BITS)
?BBCRD←←1 ;COORDS--0 MEANS NO, 1 MEANS YES
?BBSYM←←2 ;=0 JUST PROCS,PARAMS,INTERNALS; =1 ALL SYMBOLS
?BBPDSM←←4 ;PD FOR SIMPLE PROC--0 MEANS NO, 1 MEANS YES
?BBUSR←←10 ;=0 USE SYS:BAIL.REL, =1 LET USER PROVIDE HIS OWN
?BBPDS←←20 ;=1 REQUEST SYS:BAIPDn.REL, =0 DON'T
ZERODATA (DEBUGGER FLAG)
↑↑BAILON: 0 ; LEQ 0 BAIL OFF
>;BAIL
ZERODATA (OVERLAY AND OPTIMIZATION FLAGS)
?OVRSAI: 0 ;/V SWITCH. NEQ 0 FOR GENERATING OVERLAY CODE.
; MOSTLY JUST PUTTING ALL LOADER LINKED STUFF IN
; LOW SEGMENT
?WHERSW: 0 ;/W SWITCH. NEQ 0 FOR GENERATING OPTIONAL SYMBOLS
; TO HELP EXTERNAL CODE OPTIMIZER.
?XTFLAG: 0 ;/X SWITCH. COMPILER SAVE/RESTART FACILITY
;;%DN% JFR 7-1-76
?ASWITCH: 0 ;/A SWITCH, OPTIONS FOR COMPILING CODE
BITDATA(CODE OPTIONS)
?AKIFIX←←1 ;USE KIFIX
?AFIXR←←2 ;USE FIXR
?AFLTR←←4 ;USE FLTR
?AADJSP←←10 ;USE ADJSP
?ASWF10←←20 ;%DT% USE FORTRAN-10 CALL
;;%DN% ↑
; SLS VARIABLES
ENDDATA
DATA (INITIAL PROC DESC SEMBLKS)
?IPDSBK:XWD IPDASB,0
0
0
0
0
0
0
0
0
0
0
IPDASB: XWD IPDSBK,0
;;#HH#2! 5-14-72 DCS (1-2) ACCOUNT FOR POSSIBLE /H
IPDFIX: XWD 0,5 ;FIXUP FOR OUTER BLOCK STATIC LINK PUSH
;THIS MUST BE 400005 IF /H (SEE GENINI)
BLOCK 5
ENDDATA
SUBTTL Executive and Initialization
DSCR LARGER, SAIL, START
CAL Monitor-initialized
DES Re-entry, Initial Start, and subsequent Start addresses
The SAIL EXECUTIVE AND INITIALIZER -- it does these things:
1. Ask for allocation info (reenter only).
2. Scan command
3. Initialize runtime data areas
4. Initialize SAIL data areas, set up stacks, etc.
5. Prepare for compilation.
6. Compile a program
7. Go back for more or exit or start over.
⊗
DATA (INITIALIZATION FLAGS)
↑↑DSKSW: 0 ;ON IF COMMAND INPUT IS NOT FROM TTY
ENDDATA
;EXTERNAL JOBREN, JOBVER
JOBREN←←124 JOBVER←←137
LOC JOBREN ;JOBREN ← LARGER
LARGER
RELOC
LOC JOBVER
.VERSION ;CURRENT VERSION NUMBER
RELOC ;COME BACK UP
COMMENT ⊗Start, Ddtkil -- Once-only code to zap RAID, symbols
;;#IH# 7-4-72 DCS (1-2) KEEP RAID IN CORE IMAGE, NOT IN COMPILER
START sets 136 to -1, starting address to DDTKIL, and exits.
DDTKIL resets starting address to SAIL, keeps track of RPG mode.
Then, if 136<0, it resets JOBFF and LH(JOBSA) to $BGDDT, if present.
Following this, it sets total core size to 7k above (JOBFF). It
then continues into the compiler, in or out of RPG mode, depending.
NOSHRK(USER) will be set as soon as possible.
⊗
III←←0
NOTENX<
;%##% MAKE THIS KLUGE STANDARD FOR DEC OR STANFORD
IFE FTDEBUG,<
III←←1
↑↑START:
STANFORD<
RENC<
MOVE A,JOBVER
MOVEM A,JOBHGH+JOBHVR ;COPY VERSION TO HIGH VERSION
SETUWP A, ;WRITE PROTECT UPPER SGMENT
HALT .
INIT 1,17 ;MAKE COMPILER UPPER SEGMENT
SIXBIT /DSK/
0
HALT .
ENTER 1,STRTDT
HALT .
MOVE A,JOBHRL ;400000,,MAX ADDR IN UPPER
SUBI A,377777 ;400000,,LENGTH OF UPPER
HRLOI A,-1(A) ;LENGTH-1,,-1
EQVI A,377777 ;-LENGTH,,377777 [IOWD]
SETZ B,
OUT 1,A
JRST .+2
HALT .
RELEASE 1,
DATA (COMPILER SEGMENT NAME)
STRTDT: SIXBIT /SAIL/
SIXBIT /SEG/
0
0
ENDDATA
>;RENC
>;STANFORD
SETOM 136
MOVEI TEMP,DDTKIL
HRRM TEMP,JOBSA
TERPRI <SAVE ME!>
CALL6 (1,EXIT)
STANFORD<RENC<DATA (START AND SEGMENT FETCH)>;RENC
>;STANFORD
SETZM RPGSW
JRST .+3
DDTKIL: JRST .-2 ;KEEP TRACK OF RPG MODE
SETOM RPGSW
MOVEM 17,INIACS+17 ;AND INITIAL AC CONTENTS
MOVEI 17,INIACS
BLT 17,INIACS+16
;;#PN# ! RHT RESET (SO JOBFF IS OK)
CALL6 (RESET) ;
STANFORD<RENC<
JSP P,.SEG2. ;GRAB SEGMENT HERE
JRST DDTKIM ;NORMAL
JRST DDTKIM ;STPR2 WAS DONE
$PATCH: JSP P,.SEG2. ;ENTER HERE FROM RAID TO FETCH SECOND SEG
JRST @JOBDDT
HALT .
ENDDAT
DDTKIM:>;RENC
>;STANFORD
MOVE B,JOBSA ;RESET STARTING ADDRESS (AGAIN)
SKIPL 136 ;MUST WE DO ALL THIS?
JRST NOKIL ;NO, JUST GO
STANFO <
SKIPE C,JOBDDT ;ALSO FORGET IT IF NO DDT
TLNN C,-1 ; OR IF NOT NEW ENOUGH RAID
JRST NOKIL
HRL B,-11(C) ;RESET FREE ADDRESS
>;STANFO
EXPO <
SKIPN C,JOBDDT ;FORGET IF NO DDT
JRST NOKIL ;
HRL B,JOBDDT ;GET IT FROM HERE INSTEAD
>;EXPO
HLRM B,JOBFF
SETZM JOBSYM
MOVEI C,0
CALL6 (C,SETDDT) ;CLEAR OTHER GUYS
NOKIL: MOVEM B,JOBSA ;UPDATE
HRRZ B,JOBFF
ADDI B,=1024*7 ;7K FOR INITIAL DATA
CALL6 (B,CORE) ; (CORGET WON'T SHRINK IT)
JRST [TERPRI <NO CORE FOR INITIAL ALLOCATION>
CALL6 EXIT]
MOVN A,RPGSW
JRST SAIL(A) ;TAKE ACCOUNT OF RPG MODE
>;IFE FTDEBUG
;;%##% USED TO BE NOEXPO
;;#IH# (1-2)
>;NOTENX
TENX<
III←1
↑↑START:
JSYS RESET
HRROI B,HERALD
HRROI A,[ASCIZ/ Tenex SAIL 8.1 /]
SETZ C,
JSYS SIN ;COPY STRING
MOVE A,B
SETO B,
MOVSI C,044441 ;"3-2-45" FOR EXAMPLE
JSYS ODTIM ;COPY TIME
MOVE B,A ;UPDATED BP
HRROI A,[ASCIZ/ (? for help)/]
SETZ C,
JSYS SIN
MOVEI A,SAIL
HRRM A,JOBSA ;FIX UP STARTING ADDRESS
HRROI A,[ASCIZ/
SSAVE pages 0 thru 577 as <SUBSYS>SAIL.SAV
/]
JSYS PSOUT
JSYS HALTF ;IF CONTINUES, THEN FALLS THROUGH
>;TENX
COMMENT ⊗ Larger, Sail -- Execution Starts Here⊗
↑LARGER: SETOM %RENSW ;%ALLOC WILL ASK QUESTIONS
IFE III,<↑↑START:>
↑SAIL:
NOTENX <
JRST [SETZM RPGSW
JRST .+2]
SETOM RPGSW
IFE III,<
MOVEM 17,INIACS+17
MOVEI 17,INIACS
BLT 17,INIACS+16
>;IFE III
SKIPE RPGSW
JRST [SETNIT ;GET STACK
PUSHJ P,[XINI1:SETOM DSKSW
MOVE6 (CMDDEV,<DSK>) ;RPG MODE -- GET COMMANDS
CALLI 2,30 ;GET JOB NUMBER
HRLZI TEMP,DEFEXT ;OUR NAME
MOVEI 4,3
FGLUP: IDIVI 2,=10 ;FRNP
IORI TEMP,20(3)
ROT TEMP,-6
SOJG 4,FGLUP ;THREE DIGITS
MOVEM TEMP,NAME ;CCL FILE NAME
MOVE6 (EXTEN,<TMP>) ;TEMP FILE NAME
POPJ P,]
JRST BEG1]
MOVE6 (CMDDEV,<TTY>)
SETZM DSKSW ;INPUT FROM TTY -- CLEAR FLAGS
BEG1: SETOM CONFIG ;CONFIGURATION FOR COMPILER IS -1
;; #PS# (1 OF 2)DON'T SET UP MYERR IN .ERRP. UNTIL NEEDED
SKIPE XTFLAG ;ONLY ONCE, EVER
JRST BEG1XU
SETZM A,.ERRP. ;ANOTHEREXTERNAL.
SETZM GOGTAB
;;#XU# COMMAND-LINE ERROR MESSAGES NEED THIS
SETZM .ERBWD
BEG1XU: JSP P,.SEG2. ;GET A SECOND SEGMENT.
;;%AO% THIS MAY SKIP RETURN NOW
CALLI ;RESET THE WORLD
;SKIP IF HAD TO SETPR2
; A CALLI IS DONE RIGHT BEFORE SETPR2
SETNIT ;GET A UUO ADDR, AND A TEMP PUSH-DOWN STACK
SETZM LSTSTRT ;ZERO LSTSTRT ON FIRST TIME AND NON-RPG RESTARTS
>;NOTENX
TENX <;START FOR TENEX -- THIS IS SAIL
SKIPA ;STANDARD STARTING ADDRESS
JRST [SETNIT
PUSHJ P,[XINI1: SETOM DSKSW ;CCL START
SETOM RPGSW
POPJ P,]
JRST BEG1]
SETZM DSKSW
SETZM RPGSW
BEG1: SETOM CONFIG
SKIPN XTFLAG
SETZM A,.ERRP.
JSP P,.SEG2. ;GET A SECOND SEGMENT -- NO SKIP RETURN
JSYS RESET
SETNIT ;GET A UUO ADDR, STACK
SETOM HISW ;DEFAULT /H COMPILATION FOR TENEX
SETZM LSTSTRT ;ZERO LSTSTRT ON FIRST TIME AND NON-RPG RESTARTS
>;TENX
JRST XTINI3
COMMENT ⊗ XTENDED COMPILATION RESTART ⊗
NOTENX<
RENC<
DATA (EXTENDED COMPILATION RESTART ADDR)
>;RENC
EXTERNAL INIACS
SETZM RPGSW
JRST .+3
↑↑XSTART:JRST .-2
SETOM RPGSW
NOSTANFORD<
SETZM JOBHRL ;TO CURE RACE CONDITION IN DEC 5.06
>;NOSTANFORD
JSP P,.SEG2. ;GRAB OUR BUDDY BACK
JRST XTPR2W
PUUO 3,.+2
EXIT
ASCIZ /
NEED SEGMENT. TRY LATER./
XTPR2W:
RENC<
IFNDEF JOBHVR,<EXTERNAL JOBHVR>
IFNDEF JOBHGH,<EXTERNAL JOBHGH>
MOVE TEMP,JOBVER ;LOW SEGMENT VERSION
CAMN TEMP,JOBHVR+JOBHGH ;SAME AS HIGH VERSION?
JRST XTIN3A
PUUO 3,.+2
EXIT
ASCIZ /
LOSEG OUT OF DATE. RECOMPILE./
ENDDATA
>;RENC
XTIN3A:
MOVSI 17,INIACS ;GET ACS BACK
BLT 17,17
SKIPN RPGSW
JRST .+3
PUSHJ P,XINI1
JRST XTINI3
MOVE6 (CMDDEV,<TTY>)
SETZM DSKSW ;INPUT FROM TTY -- CLEAR FLAGS
SETZM RPGSW ;AND INDICATE SOURCE OF INPUT
;GIVE BACK CORGET BUFFER SPACE FOR SRC, REL, LST
HRRZ TEMP,SRCHDR
PUSHJ P,GBBUF
HRRZ TEMP,BINHDR
TLNE FF,BINARY
PUSHJ P,GBBUF
HRRZ TEMP,LSTHDR
TLNE FF,LISTNG
PUSHJ P,GBBUF
XTINI3:
>;NOTENX
TENX<
RENC< DATA (EXTENDED COMPILATION RESTART ADDR)
>;RENC
EXTERNAL INIACS
SETZM RPGSW
JRST .+3
↑↑XSTART:JRST .-2
SETOM RPGSW
JSP P,.SEG2.
JRST XTIN3A
RENC< ENDDATA>
XTIN3A:
MOVSI 17,INIACS
BLT 17,17
SKIPN RPGSW
JRST XTIN4A
PUSHJ P,XINI1
JRST XTINI3
XTIN4A: SETZM DSKSW
SETZM RPGSW
;;;PERHAPS ADD CODE TO GIVE BACK THE BUFFER SPACES HERE
XTINI3:
>;TENX
NOTENX <
;THIS IS DONE IN TENEX COMMAND SCANNER LATER
; PRINT CRLF *
MOVE TEMP,[OUTSTR [PROCSR]]
SKIPE XTFLAG
MOVE TEMP,[OUTSTR [ASCIZ/XSAIL:/]]
SKIPN RPGSW ;NO STAR IF IN RPG MODE
MOVE TEMP,[OUTCHR ["*"]]
XCT TEMP
NOS:
; GET ENOUGH OF COMMAND LINE TO BEGIN PROCESSING
REN<
SKIPN XTFLAG
SETZM HISW ;ASSUME NO TWO-SEGMENT COMPILATION
>;REN
;;%BZ% !
HLLZS EXTEN
SETZM WORD3 ;WORDS 3 AND 4 OF ENTER TABLE
SETZM PPN
;;=I13= JFR 1-2-77
DEC<
CALL6 (A,GETPPN) ;get my ppn for use in filename scanning
MOVEM A,MYPPN
>;DEC
; WILL RETURN HERE WHENEVER @ IS DETECTED FOLLOWING A FILE NAME
COMNIT: SETZM SAVTYI ;LOOKAHEAD CHARACTER
;;#UP# ! JFR 7-29-75 ALLOW MANUAL START AFTER RPG START
SETZM CMDMOD
IFN TMPCSW,< ;IF TMPCOR FEATURE AVAILABLE
;; #VO# 2! JFR 10-31-75 TMPCOR ONLY IF RPG MODE
SKIPN RPGSW
JRST NOTMP
MOVSI A,DEFEXT ;TEMPCORE UUO FOR STANDARD DEC
MOVEM A,CMDPNT ;DEC SYSTEM
MOVE A,[XWD -170,CMDBUF]
MOVEM A,CMDPNT+1
MOVE A,[XWD 2,CMDPNT];READ AND DELETE TEMP CORE
CALLI A,44
JRST NOTMP ;LOOK ON DSK AS USUAL
IMULI A,5 ;NUMBER OF CHARS
MOVEM A,CMDCNT ;FUDGED COUNT
MOVE A,[POINT 7,CMDBUF+1]
MOVEM A,CMDPNT ;BYTE POINTER
SETOM CMDMOD ;TO DETECT TMPCORE IN USE
JRST FILEOK
NOTMP:
>;IFN TMPCSW
RELEASE CMND,0 ;MAKE SURE FILE IS RELEASED
MOVEI SBITS2,CMDCDB ;OPEN COMMAND FILE
HRLI SBITS2,-1 ;INDICATE NO CORGET
PUSHJ P,OPNUP ;(1 INBUF RQST IMPLIES NO CORGET, USE CMDBUF
IOERR <COMMAND DEVICE NOT AVAILABLE>
JRST TRGAIN ;LOOKUP FAILED
JRST FILEOK ;ALL OK
TRGAIN: SKIPN RPGSW ;PRINT MESSAGE IF NOT IN RPG MODE
IOERR <COMMAND FILE NOT FOUND>
SKIPL XTFLAG
JRST SAIL ;OTHERWISE ENTER NORMAL TTY MODE
JRST XSTART
>;NOTENX
COMMENT ⊗ Morfiles -- Execution Returns Here Each New Command Line⊗
FILEOK:
DSCR MORFILES
DES Will return here whenever another command line is wanted
CAL in line
⊗
MORFILES:
SKIPGE XTFLAG
JRST XINI4
MOVEI FF,0 ;CLEAR FLAG WORD
SETZM GOGTAB ;FORCE INITIALIZATION OF CORE AREAS
;;#XU# ! JFR 11-26-76
SETZM .ERBWD
; IT IS NOW SAFE (AND NECESSARY) TO CLEAR ALL THOSE VARIABLES
; DECLARED VIA ZERODATA MACRO
SETZM ZBASE
MOVE TEMP,[XWD ZBASE,ZBASE+1]
BLT TEMP,ZBASE+ZSIZE-1 ;ANY ARGUMENTS?
MOVE TEMP,[XWD DEFSIZ,SPREQ+$SPREQ];MOVE DEFAULTS TO REQUEST BLOCK
BLT TEMP,SPREND
TENX<
SETOM HISW ;DEFAULT /H FOR TENEX
>;TENX
XINI4:
MOVEI TEMP,MACLST+PCOUT+LINESO ;ASSUME THIS ABOUT LISTING
MOVSM TEMP,SCNWRD
;;%DF%
LSH TEMP,-=13 ;REMEMBER THIS WAY TOO
MOVEM TEMP,FMTWRD
;;%DF% ↑
;RESET SRCCDB, AVLSRC IN CASE RESTART CLOBBERED IT IN SWITCH MODE
SETZM SWTLNK ;NO LINKS BACK
SETZM SRCDLY
SETZM BUFADR
NOTENX <
;;#%%# ! BY JFR 11-27-74 USED TO BE 17774,,0
MOVSI TEMP,3774 ;CH7 AND ABOVE AVAILABLE
MOVEM TEMP,AVLSRC
MOVEI TEMP,SRC
FOR II←0,1 <
DPB TEMP,[POINT 4,SRCOP+II,12]
>
FOR II←0,3 <
DPB TEMP,[POINT 4,INSRC+II,12]
>
NOEXPO <
DPB TEMP,[POINT 4,SRCOP+2,12] ;PUSHJ IF EXPO
>;NOEXPO
>;NOTENX
PUSHJ P,COMND ;CALL COMMAND SCANNER
ERR <FATAL END OF SOURCE FILE>
PUSHJ P,SALNIT ;INITIALIZE RUNTIM, SAIL
PUSHJ P,MAKT ;PREPARE TITLE LINE
;;%DE% JFR 10-24-75
MOVE LPSA,SYMTAB
HRROI TEMP,1+[=15
POINT 7,[ASCII/COMPILER_BANNER/]]
POP TEMP,PNAME+1
POP TEMP,PNAME
PUSHJ P,SHASH ;FIND IT IN SYMBOL TABLE
MOVEI TEMP,BANMAC ;NEW BODY
HRLM TEMP,%TLINK(LPSA)
;;%DE% ↑
PUSHJ P,HDR ;INIT PAGE NOS., PRINT HEADING IF LISTING
SKIPGE XTFLAG
JRST XTCOPY ;WORLD LOOKS NICE, RESTORE PREVIOUS
;STATE OF FILES
PUSHJ P,GENINI ;INITIALIZE GENERATORS
PUSHJ P,MKNSTB ; INITIALIZE NESTABLE DELIMITER TABLE
QPUSH(DELSTK,REQDLM) ; INITIALIZE DELIMITER STACK TO NONE SPECIAL
; DELIMITER MODE
; TURN ON CONDITIONAL ASSEMBLY RESERVED WORD FLAG BELOW
HRLZI A,IF0OFF ; INITIALIZE OFFSET FOR STORING AN INDEX INTO A
; TABLE FOR ACCESSING THE ADDRESSES OF PRODUCTIONS
; WHICH ARE ENTERED BY A PUSHJ AFTER AN INTERRUPT.
; THESE INDICES ARE LOADED INTO BITS 6-8 OF THE
; $TBITS ENTRY OF THE CORRESPONDING RESERVED WORD.
MOVE B,[XWD -NMCRES,RESLOC] ; SET UP LOOP
CONAGN: MOVE TEMP,(B) ; GET RESERVED WORD DESCRIPTOR
TLZ TEMP,CONBTS ; TURN OFF FLAG ENTRIES IN THE BYTE POINTER
HLRZM TEMP,PNAME ; LOAD RIGHT HALF OF PNAME WITH COUNT
HRLI TEMP,(<POINT 7,0>); FORM BYTE POINTER
MOVEM TEMP,PNAME+1 ; LOAD PNAME+1 WITH BYTE POINTER
MOVE LPSA,SYMTAB ; GET BASE ADDRESS OF SYMBOL TABLE
PUSH P,B ; SAVE B
PUSH P,A ; SAVE OFFSET
PUSHJ P,SHASH ; GET THE SEMBLK ADDRESS
POP P,A ; RESTORE A
POP P,B ; RESTORE B
HLLZ TEMP,(B) ; GET LEFT HALF OF RESERVED WORD DESCRIPTOR
AND TEMP,[XWD CONBTS,0] ; REMOVE CHARACTER COUNT FROM LEFT HALF OF TEMP.
TLNE TEMP,DEFINT+CONDIN ; IF THE RESERVED WORD INDICATES THAT A
JRST[TDO TEMP,A ; PRODUCTION IS TO BE CALLED VIA A PUSHJ RATHER
ADD A,[XWD IF0OFF,0] ; THAN A RESUME THEN SET BITS 6-8 IN $TBITS TO
JRST .+1] ; REFLECT THE PRODUCTION THAT IS TO BE STARTED.
IORM TEMP,$TBITS(LPSA) ; SET COND. ASSEMBLY RESERVED WORD FLAGS
AOBJN B,CONAGN ; IF NOT DONE, GET NEXT
; SET UP PARSER STACK POINTERS WHICH ARE NOT YET BEING SET UP BY THE RUNTIME
; ROUTINES. THESE ARE THE SEMANTIC, PARSE, AND CONTROL STACK POINTERS FOR
; THE CONDITIONAL PARSER AND THE SAIL PARSER. ALSO SET UP THE CONTROL STACK
; POINTER FOR THE GENERAL PARSER.
MOVE TEMP,GPSAV ; GET SAIL SEMANTIC STACK POINTER
MOVEM TEMP,SGPSAV ; STORE IT
MOVE TEMP,PPSAV ; GET SAIL PARSE STACK POINTER
MOVEM TEMP,SPPSAV ; STORE IT
MOVE TEMP,PCSAV ; SAIL PROD. CONTROL STACK POINTER
PUSH TEMP,[XWD -1,RELSE] ;PARSER WILL "POPJ" TO HERE
;SEE "COMPILED PRODUCTIONS" EXPL.
PUSH TEMP,[PRODGO] ; ADDRESS OF FIRST SAIL PRODUCTION
MOVEM TEMP,SPCSAV ; STORE THE POINTER
MOVEM TEMP,PCSAV ; FIRST CALL TO SCANNER WITH SAIL IN CONTROL
;++++
MOVE TEMP,CPCSAV ;
PUSH TEMP,[CPRODGO] ; INIT OTHER PARSER TO AN ERROR MESSAGE
;; #NO SINCE SWITCHING PARSERS FOR ELSEC OR ENDC WILL POP PCSAV
;; MUST HAV TWO ENTRIES ON CPCSAV STACK TO GET ERROR MESSAGE
PUSH TEMP,[CPRODGO] ; INIT OTHER PARSER TO AN ERROR MESSAGE
MOVEM TEMP,CPCSAV ;
;++++
SETZM PRSCON ; DITTO
QPUSH (ENDCTR,[0]) ; INITIALIZE ENDCTR STACK
QPUSH (RECSTK,IFCREC) ; INITIALIZE RECSTK STACK
SETOM SWCPRS ; SWITCHING PARSERS IS PERMISSIBLE
MOVEI TEMP,4001 ; INITIALIZE SCNNO, SSCNNO, AND CSCNNO TO
MOVEM TEMP,SCNNO ; ONE SO THAT ONE WILL NOT POP THE PCSAV
PUSHJ P,SCANNER ;INITIALIZE FOR PARSERS -- ONE SCAN
MOVEM SP,PPSAV ;SAVE FIRST RESULT PTR
;; #PS# WAIT TILL LAST MOMEMT TO SET UP ERROR HANDLER
MOVEI TEMP,MYERR
MOVEM TEMP,.ERRP.
JRST PARSE ;THIS HERE IS THE COMPILER!
; ...
RELSE: MOVE TEMP,PCNT ;UPDATE LISTING OFFSET
ADDM TEMP,LSTSTRT
NOTENX <
RELAL: RELEASE LST,0
RELEASE BIN,0
RELEASE SRC,0
RELEASE LOG,0
;; %BC%
BAIL <
RELEASE SM1,0
>;BAIL
;; %BC%
TERPRI
EOLCHK: SKIPE EOL ;SCAN UNTIL EOL COMES ON IN CASE
JRST ENDCOM ; GARBAGE WAS PRESENT AT END OF
PUSHJ P,WORD ; LINE
JRST EOLCHK
ENDCOM:
;;=I06= IF THERE WAS AN ERROR IN BATCH JOB, TYPE ?
DEC<
SKIPLE %BATCH ;.LT. IF NOT BATCH, .EQ. IF NO ERROR
OUTSTR [ASCIZ /? Error detected
/] ;if error in batch job, stop it
SETZM %BATCH ;reinit in case done again
> ;DEC
;;=I06= ↑
;; 2! JFR 10-30-75 BETTER WAY TO FORCE EXIT FOR /X
SKIPE XTFLAG
JRST EXXIT ;/X ON, EXIT FORCED
SKIPN DSKSW ;NOW GO BACK IF IN TTY MODE, ELSE EXIT
JRST SAIL ; IF END OF FILE, ELSE
SKIPN EOF ; USE NEXT LINE OF COMMAND
JRST MORFILES ; FILE IF THERE IS MORE.
EXXIT:
CALL6 (EXIT) ;STAGE LEFT.
>;NOTENX
TENX <
EXTERNAL RUNPRG
HRROI A,[ASCIZ/
End of compilation.
/]
JSYS PSOUT
TLNE FF,BINARY ;DONT LOAD IF NO BINARY
SKIPN LODMOD ;LOAD IMMEDIATELY?
JRST CLOZZZ ;NO
MOVEI A,400000 ;THIS FORK
SETO B,
JSYS DIC
JSYS CIS
MOVEI A,10 ;CONTROL-H INTERRUPT
JSYS DTI ;DEASSIGN TERMINAL CODE
SETZM TMPCBF
MOVE A,[XWD TMPCBF,TMPCBF+1]
BLT A,TMPCBF+37
HRROI B,TMPCBF
SETZ C,
HRROI A,[SLOLOD]
JSYS SIN ;COPY OVER THE SAILOW NAME
HRROI A,[ASCIZ/DSK:/] ;ASSUME NO DDT
SKIPE LODDDT ;WANT A DDT?
HRROI A,[ASCIZ@/TDSK:@]
JSYS SIN ;COPY OVER
MOVE A,B ;DESTINATION DESIGNATOR
HRRZ B,BINJFN
HRLZI C,1000 ;FILE NAME ONLY
JSYS JFNS ;COPY RELFILE NAME
MOVEI C,"."
IDPB C,A ;MAKE "FILE.EXT"
HRLZI C,000100 ;EXTENSION ONLY
JSYS JFNS
MOVE B,A ;DESTINATION DESIGNATOR
IMSSS<
SKIPN LODSDT ;WANT SDDT?
JRST NOSDT ;NOPE
HRROI A,[SDTLOD]
SETZ C,
JSYS SIN
NOSDT:
>;IMSSS
MOVEI C,175
IDPB C,B ;FINISH COMMAND
SETO A,
JSYS CLOSF ;CLOSE ALL FILES
JFCL ;ERROR RETURN
IMSSS <
SETO A,
MOVEI B,TMPCBF
JSYS PTINF ;PASS INFO TO THE LOADER
JFCL ;ERROR RETURN
>;IMSSS
NOIMSSS<
ZERODATA
CCLLOD: BLOCK 3
ENDDATA
JSYS GJINF ;GET THE JOB NUMBER
MOVEM C,B ;SAVE THE JOB NUMBER IN B
HRROI A,CCLLOD
MOVE C,[XWD 140003,12] ;DECIMAL, FIELD LENGTH 3, LEADING ZEROS
JSYS NOUT
JFCL
MOVEM A,B ;DESTINATION BP
HRROI A,[ASCIZ/LOA.TMP/]
SETZ C, ;COPY UNTIL NULL BYTE
JSYS SIN
MOVSI A,400001 ;WRITING, BP IN 2
HRROI B,CCLLOD
JSYS GTJFN
ERR <Cannot chain to LOADER>,1
MOVE B,[XWD 70000,100000]
JSYS OPENF
ERR <Cannot chain to LOADER>,1
SETZ C,
HRROI B,TMPCBF
JSYS SOUT
JSYS CLOSF
JFCL
>;NOIMSSS
PUSH P,[1] ;CCL MODE
PUSH P,[0] ;THIS FORK
EXCH SP,STPSAV
PUSH SP,LODDER
PUSH SP,LODDER+1
PUSHJ P,RUNPRG
EXCH SP,STPSAV ;CANNOT GET HERE AT ALL
JRST SAIL ;ERROR RETURN
CLOZZZ: SETO A,
JSYS CLOSF
JFCL
;; 2! JFR 10-30-75 BETTER WAY TO FORCE EXIT IF /X
SKIPE XTFLAG
JRST EXXIT
JRST SAIL
EXXIT: JSYS HALTF
JRST .-1
LODDER: RUNLOD
>;TENX
COMMENT ⊗ Salnit -- Storage Initialization, Etc.
This routine handles steps 2-5 of the initializing procedure ⊗
↑SALNIT:
NOGEN
SKIPGE XTFLAG
JRST XTINI2
; INITIALIZE RUNTIME DATA AREAS
POP P,GENLEF ;ALLOC WILL LOSE STACK
JSP 16,%ALLOC ;SET THEM UP
;;#IH#? 7-4-72 DCS (2-2) IMPROVE CORE ASSIGNMENT
SETOM NOSHRK(USER) ;PREVENT CAPRICIOUS CORE RELEASE
PUSH P,GENLEF ;RETURN RETURN TO STACK
PUSH P,[%ARRSRT] ;REMOVE FROM GARBAGE COLLECT RING
PUSHJ P,SGREM
; CLEAR SAIL SWITCHED DATA AREA, FF, JOBERR
SKIPN RPGSW ;IF NO ONE CAME BEFORE,
SETZM 42 ; NO ERRORS YET
TLO FF,TOPLEV!MAINPG ;MAIN PROGRAM AND MARK TOP LEVEL
SETZM SLD1
MOVE TEMP,[XWD SLD1,SLD1+1] ;CLEAR ANOTHER AREA
BLT TEMP,ENDSRC
; ENABLE FOR PDL OVERFLOW INTERRUPT, SET UP TABLE TO DESCRIBE
; PROBABLE CAUSES (SEE SETPOV IN HEAD, POVTRP IN COMSER)
IFN 0, < ;THIS IS THE WAY IS USED TO BE -- RHT
;;#GH# DCS 2-1-72 (1-5) USE DIFFERENT INTERRUPT TO CATCH <ESC>I
MOVEWI JOBAPR,INTRPT ;ADDRESS OF INTERRUPT ROUTINE
;;#GH# USED TO BE POVTRP
EXPO <
MOVEI TEMP,INTPOV ;ENABLE FOR PDLOV ONLY
CALL TEMP,['APRENB'] ;TELL THE SYSTEM
>;EXPO
NOEXPO <
MOVE TEMP,[XWD INTTTI,INTPOV];MOVEI TEMP,INTPOV
CALL6 (TEMP,INTNB) ;ENABLE FOR GOOD KIND OF INTERRUPT
>;NOEXPO
;;#GH#
>;IFN 0
XTINI2:
NOTENX <
;;%AY% RHT 2-12-73 USE THE INTMAP RUNTIME ROUTINE FOR THIS
EXTERN ENABLE,INTMAP
NOEXPO < ;THIS TIME DO <ESC>I
PUSH P,[ITTYIX]
PUSH P,[ITTYDO]
PUSH P,[0]
PUSHJ P,INTMAP
PUSH P,[ITTYIX]
PUSHJ P,ENABLE
>;NOEXPO
PUSH P,[IPOVIX] ; PDL OV
PUSH P,[POVDO]
PUSH P,[0]
PUSHJ P,INTMAP
PUSH P,[IPOVIX]
PUSHJ P,ENABLE
;;%AY%
>;NOTENX
TENX <
;Don't use Tenex INTMAP because it saves ac's, unneeded for <ESC I>
;which saves TEMP itself, and plain wrong for POVDO which must set
;up TEMP for forced Debrk to itself.
;First make sure we got an interrupt system.
HRRZI A,400000 ;THIS FORK
JSYS RIR ;READ INTERRUPT SYS. TABLE ADDR.
EXTERN LEVTAB,CHNTAB,ATI,ENABLE
JUMPE 2,[MOVE 2,[XWD LEVTAB,CHNTAB] ;XX'D IN GOGOL
JSYS SIR ;SET INT. SYS. TABLES
JRST .+1]
JSYS EIR ;ENABLE INT. SYS - GENERAL TURN-ON
MOVE A,[XWD 3,POVDO] ;DISPATCH VECTOR FOR PDLOV
MOVEM A,IPOVIX(2) ;IPOVIX MUST BE =9
MOVE A,[XWD 3,ITTYDO] ;FOR <ESC I> (I.E. CTRL H)
MOVEM A,ITTYIX(2) ;INTMAPS DONE. ENABLES:
PUSH P,[IPOVIX]
PUSHJ P,ENABLE
PUSH P,[ITTYIX]
PUSHJ P,ENABLE ;AND THEN ACTIVATE TERMINAL INTERRUPT
PUSH P,[ITTYIX]
PUSH P,[10] ;TERMINAL INTERRUPT CODE FOR CTRL-H
PUSHJ P,ATI
>;TENX
SKIPGE XTFLAG
JRST XTINI4
SETPOV (P,SYSTEM!PDL -- USE /P TO INCREASE)
SETPOV (SP,PARSE STACKS -- USE /R TO INCREASE)
SETPOV (PNT,<DEFINE STACK -- CHECK FOR MACRO RECURSION,
OR USE /D TO INCREASE>)
;GP←←7
SETPOV (7,PARSE STACKS -- USE /R TO INCREASE)
SETPOV (SP-1,STRING!PDL -- USE /Q TO INCREASE)
;LATTER IS KLUDGE -- MOVSS OF WORD CONTAINING PARSE-STRING
;WARNINGS WILL BE DONE WHENEVER SP CONTAINS STRING PDP --
;INCLUDED FOR SPEED, BUT DECIDEDLY DANGEROUS IF ACS ARE
; EVER REDISTRIBUTED
SETOM STPAGE ;DON'T STOP ON PAGE NUMBERS
; AOS SALSTR ;MARK SAIL "PROCEDURE" ACTIVE FOR STRGC
MOVE USER,GOGTAB
SETOM NOSHRK(USER) ;DON'T LET CORREL SHRINK CORE
;SET UP INITIAL SYMBOL TABLE AND BUCKETS
PUSHJ P,SETBLK ;GET SYMBOL BLOCKS
MOVEI LPSA,IPROC ;TOP LEVEL VARB RING
; DCS 9-21-71
SETZM %RSTR(LPSA) ;CLEAR STRING RING ENTRY
MOVEM LPSA,STRRNG ;PUT PROGRAM NAME BLOCK ON STRING RING
; DCS
SETZM QQFLAG ;INITIALIZE UNDECLARED IDENTIFIER STUFF
SETZM QQBLK ;
MOVEM LPSA,VARB ;INITIAL VARB LIST
MOVEM LPSA,TPROC ;TOP LEVEL PROCEDURE
MOVEM LPSA,TTOP ;TOP LEVEL BLOCK
MOVEI TEMP,MBLK ;GIVE TOP-LEVEL PROC A 2D BLOCK
HRLM TEMP,%TLINK(LPSA)
MOVEI TEMP,1
MOVEM TEMP,$PNAME(LPSA) ;"M" IS DEFAULT PROGRAM
MOVE TEMP,[<POINT 7,[ASCII /M/]>] ; NAME
MOVEM TEMP,$PNAME+1(LPSA)
;;#TN# BIG HACK
MOVE TEMP,[XWD OWN,PROCED] ;MAKE THE TBITS CORRECT
MOVEM TEMP,$TBITS(LPSA)
;;#TN# ↑
SETZM $ACNO(LPSA)
;;%BT%
MOVEI A,3 ;PCNT AT "PRDEC"
HRLZM A,$VAL2(LPSA) ;
HRRZM A,$ADR(LPSA) ;ALSO STARTING ADR OF "PROCEDURE"
;;%BT% ↑
INITPD: MOVEI TEMP,IPDSBK
MOVEM TEMP,$VAL(LPSA)
SETZM $PNAME(TEMP)
SETZM $PNAME+1(TEMP)
;;%BT%
HRLZI A,7
MOVEM A,$ACNO(TEMP) ;PCNT after mksemt
;;%BT% ↑
SETZM $VAL(TEMP)
SETZM $VAL2(TEMP)
SETZM $ADR(TEMP)
HLRZ TEMP,%TLINK(TEMP)
;;%AL% CHANGED THE INITIAL CODE SEQUENCE
HRRZI A,4 ;FIXUP FOR [PDA,0]
;;#KC# 11-12-72 RHT -- FIX FOR HIGH SEGS
REN <
SKIPE HISW ;HIGH SEG?
TRO A,400000 ;YES
>;REN
;;#KC#
HRRM A,$ADR(TEMP)
SETZM $VAL2(LPSA)
JRST ZEVB
ZERV: LEFT ,%RVARB,ZSTR ;GO ALONG VARB LIST ZEROING
ZEVB: HLLZS $ADR(LPSA) ;THE RIGHT THINGS
JRST ZERV
ZSTR: GETBLK STRCON ;BUCKET FOR STRINGS
GETBLK CONST ;AND FOR NUMERIC CONSTANTS
GETBLK SYMTAB ;SYMBOL TABLE BUCKET
HRLI LPSA,MBUCK ;INITIAL BUCKET
MOVE TEMP,LPSA
BLT LPSA,BLKLEN-1(TEMP)
;NOW INITIALIZE QSTACK FOR COUNTER FIXUPS
SKIPN KOUNT ;ARE WE GOING TO PUT OUT COUNTERS
JRST .+4 ;NO
MOVNI A,1 ;GET A -1
MOVEI LPSA,KPDP ;POINT TO THE QSTACK (EMPTY AT THIS POINT)
PUSHJ P,BPUSH ;PUSH ON THE MARKER
; NOW SET UP OTHER PUSH-DOWN LISTS
MOVEM SP,STPSAV ;SAVE STRING POINTER
MOVE SP,PPSAV ;AND SET UP PARSE POINTER
XTINI4: HLLZ TEMP,SCNWRD ;FINISH UP THE LIST CONTROL WORD
TLC TEMP,MACLST!MACEXP
TLCN TEMP,MACLST!MACEXP ;BOTH EXPAND AND LIST NAMES
TLO TEMP,LSTEXP ;YES
;;#GR# DCS 2-8-72 (1-3) MINOR FTDEBUGGER FIXES
; REMOVE ANY BREAKPOINTS SET BY FTDEBUGGER
; #GR# FIX REMOVED WHEN RAID IMPROVED 6-12-72
CKLS: TLNN FF,LISTNG ;LISTING?
;;#GR# (1)
MOVEI TEMP,1 ;NO, NOLIST ON, ALL OTHERS OFF
MOVEM TEMP,SCNWRD ;UPDATE
TLNN FF,LISTNG ;LISTING?
POPJ P, ; NO
MOVEI C,=50 ;GET SOME CORE FOR LISTING FILE
PUSHJ P,CORGET
ERR <DRYROT AT LSTGET>,1
MOVEM B,LSTBUF ;LOC OF LIST OUTPUT BUFFER
HRLI B,440700 ;INIT BYTE POINTER
MOVEM B,LPNT ;LIKE THAT
;;%EB%
STSW(FTL$DBG,STANSW&FTDEBUG)
IFN FTL$DBG,<
MOVEI C,5*=50
MOVEM C,L$CNT
>;IFN FTL$DBG
;;%EA% 4! JFR 1-28-77 TURN OFF SOS LINE NUMBER BITS
SETZM (B)
MOVSI C,(B)
IORI C,1(B)
BLT C,=50-1(B)
POPJ P, ;RETURN FROM SAIL INIT
COMMENT ⊗ XTCOPY, RESTORE PREVIOUS STATE OF .REL FILE ⊗
NOTENX<
XTCOPY:
POP P,PPN ;MOVE INFO INTO LOOKUP BLOCK
POP P,EXTEN
POP P,NAME
POP P,TMQDEV
MOVEI SBITS2,TMQCDB ;INPUT CDB
MOVEI TBITS2,BINCDB ;OUTPUT CDB
MOVSI SBITS,(<OUT BIN,>) ;OUTPUT INSTR
SKIPE TMQDEV
PUSHJ P,XTCOP1 ;COPY OLD .REL FILE
POP P,PPN
POP P,EXTEN
POP P,NAME
POP P,TMQDEV
MOVEI TBITS2,SM1CDB ;OUTPUT CDB
MOVSI SBITS,(<OUT SM1,>) ;OUTPUT INSTR
SKIPE TMQDEV
PUSHJ P,XTCOP1 ;COPY OLD .SM1 FILE
HRRZS XTFLAG ;RESET LEFT HALF
JRST XTCONT ;GET BACK INTO SCANNER LOOP
XTCOP1:
PUSHJ P,OPNUP ;OPEN TMQ (OLD BIN) FILE, INPUT
IOERR <OPEN ERROR: TMQ>
IOERR <LOOKUP ERROR: TMQ>
MOVEI A,[ASCIZ/
Copying @F:@F.@F@G
/]
MOVEI B,-1+[ PWORD CDEV(SBITS2)
PWORD CFIL(SBITS2)
PLEFT CEXT(SBITS2)
PWORD CPPN(SBITS2)]
PUSHJ P,SPLPRT
XTCLUP: SOSGE CCNT(SBITS2) ;COPY TMQ TO BIN.
JRST XTCIN ;CANT USE INOUT BECAUSE DIFFERENT
ILDB TEMP,CPNT(SBITS2) ;DATA STRUCTURES FOR FILES
SOSG CCNT(TBITS2) ;IN COMPILER/RUNTIMES
JRST XTCOUT
XTCLP1: IDPB TEMP,CPNT(TBITS2)
JRST XTCLUP
XTCIN: IN TMQ,
JRST XTCLUP ;NO ERROR
GETSTS TMQ,TEMP
TRNE TEMP,740000 ;CHECK ERROR BITS
IOERR <INPUT ERROR: TMQ>
TRNE TEMP,20000 ;CHECK EOF BIT
JRST XTCDON ;YES
JRST XTCLUP
XTCOUT: XCT SBITS ;OUT CHAN,
JRST XTCLP1 ;NO ERROR
IOERR <OUTPUT ERROR>
JRST XTCLP1
XTCDON: RELEASE TMQ,
HRRZ TEMP,CHDR(SBITS2)
;GIVE BACK BUFFER SPACE
GBBUF: ;ENTER WITH TEMP=ADDR OF SOME BUFFER
HRRZ B,(TEMP) ;ADDR OF NEXT BUFFER
CAIG B,(TEMP)
JRST GBBUF1 ;B IS ADDR+1 OF FIRST BUFFER
MOVEI TEMP,(B) ;TRY AGAIN
JRST GBBUF
GBBUF1: MOVEI B,-1(B) ;FWA CORGET BLOCK
JRST CORREL
>;NOTENX
TENX<
XTCOPY:
BEGIN XTCOPY
SKIPN BINJFN
JRST NOXTB
PUSH P,BINJFN
PUSH P,[XWD -1,XTBFIL]
PUSHJ P,XTCOP1
NOXTB: SKIPN SM1JFN
JRST NOXTS
PUSH P,SM1JFN
PUSH P,[XWD -1,XTSFIL]
PUSHJ P,XTCOP1
NOXTS: HRRZS XTFLAG
JRST XTCONT
XTCOP1:
;CALL TO HERE WITH PUSHJ P,
;ARGS ON STACK: -2(P) JFN TO COPY TO
; -1(P) BP TO STRING WITH SOURCE FILE NAME
MOVSI 1,100001
MOVE 2,-1(P)
JSYS GTJFN
IOERR <GTJFN ERROR ON TMQ FILE>
MOVE 2,[XWD 440000,200000] ;READ, 36 BIT, MODE 0
JSYS OPENF
IOERR <OPENF ERROR ON TMQ FILE>
MOVEM 1,-1(P) ;PUT JFN ON STACK
HRROI 1,[ASCIZ/
Copying /]
JSYS PSOUT
PUSH P,-1(P)
PUSHJ P,DOJFNS
HRROI 1,[ASCIZ/ to /]
JSYS PSOUT
PUSH P,-2(P)
PUSHJ P,DOJFNS
HRROI 1,[ASCIZ/
/]
JSYS PSOUT
;THOUGH SOMEWHAT SLOW, WE WILL USE BYTE IO SINCE IT IS
;MORE EASILY DONE WITHOUT BUFFERS ETC
XTCLUP: MOVE 1,-1(P) ;SOURCE JFN
JSYS BIN
JUMPE 2,CHKEOF ;0, BETTER TEST EOF
NOTEOF: MOVE 1,-2(P) ;DESTINATION JFN
JSYS BOUT
JRST XTCLUP
CHKEOF:
JSYS GTSTS
TLNE 2,(1B8) ;END OF FILE?
JRST ISEOF ;YES
SETZ 2, ;NO, CONTINUE
JRST NOTEOF
ISEOF: MOVE 1,-1(P)
JSYS CLOSF
IOERR <CANNOT CLOSF TMQ FILE>
SUB P,X33 ;CLEAR STACK
JRST @3(P) ;RETURN
DOJFNS:
;CALL WITH PUSHJ
;JFN AT -1(P)
MOVEI 1,100 ;PRIMARY OUTPUT
MOVE 2,-1(P)
SETZ 3,
JSYS JFNS
SUB P,X22
JRST @2(P)
BEND XTCOPY
>;TENX
SUBTTL COMMAND SCANNER DATA (CDB's)
SUBTTL Comnd, aux. routs -- Command Scanner
EXTERNAL SPLPRT
NOTENX <
;Everything from here to the end of SAIL has been switched out
;for TENEX except for the code at DELIM & UNSWT. A new file, CC, exists
;which should be assembled after SAIL and contains the TENEX code
;(not under a switch tho', Stanford just skips the file).
BITDATA (INDICES INTO CDBS)
CMOD←←0
CDEV←←1
CHED←←2
CHDR←←3
CPNT←←4
CCNT←←5
CFIL←←6
CEXT←←7
;;#%%# BY JFR 11-7-74 PPN NOW KEPT IN CDB
CPPN←←10
COPN←←11
CENT←←12
CSPC←←13
CBFS←←14
;;=I10= ADD SFD'S
SFDS<
CPATH←←16
> ;SFDS
ENDDATA
DSCR COMND and friends
COMMAND SCANNER -- ALLOWS COMMANDS OF THE FORM
<FILENAME><,FILENAME> ← FILENAME<,FILENAME>*
WHERE THE STAR INDICATES ANY NUMBER OF REPETITIONS
EACH FILE NAME CAN BE FORMED FROM THE FOLLOWING PATTERN:
<DEVICE:><NAME><.EXT><[PROJ,PROG]>
THERE ARE SOME EXTRA RULES ABOUT WHAT MAY BE LEFT OUT
IF EITHER DEVICE OR NAME MUST BE PRESENT. DSK
IS ASSUMED IF DEVICE IS OMITTED. NAME MUST BE PRESENT IF
EXT OR PROJ,PROG ARE USED.
THE SCANNER ASSUMES .REL FOR BINARY EXTENSIONS, .LST FOR
LISTING FILE EXTENSIONS, AND TRIES BOTH .GOG AND BLANK EX-
TENSIONS FOR THE SOURCE FILES.
IF ONE OVERRIDES THE DEVICE ASSUMPTION (DSK), IT HOLDS ONLY
FOR A SINGLE FILE TO THE LEFT OF THE ARROW. IT HOLDS
UNTIL REPLACED ON THE RIGHT SIDE.
A PPN OTHER THAN 0 HOLDS ONLY FOR ONE FILE NAME
IT WOULD BE WISE NOT TO COUNT ON ANY BUT THE FIXED ACS
AFTER RETURN FROM COMND
⊗
DATA (COMMAND SCANNER VARIABLES)
COMMENT ⊗ The CDBs (Channel data blocks) specifying file parameters
for all files except the source file (see SRCCDB in switched data
in main SAIL data area) are located here.
⊗
; COMMAND FILE
MAKCDB(CMND,CMD,0,1,0)
; BINARY OUTPUT FILE (REL FILE)
MAKCDB(BIN,BIN,10,0,=8)
; TEXT OUTPUT FILE (LISTING FILE)
MAKCDB(LST,LST,0,0,=8)
;; %BC%
BAIL <
; SYMBOL TABLE FILES
MAKCDB(SM1,SM1,10,0,2)
>;BAIL
;; %BC%
XCOM<
MAKCDB(TMQ,TMQ,10,=8,0) ;TEMP FOR COPYING
>;XCOM
; COMMAND FILE BUFFER AREA -- not taken from free storage so that
; data can be retained over multiple compilations (free storage
; reinitialized for each). OPNUP routine does the right thing
; about getting JOBFF set up right.
CMDBUF: BLOCK 206 ;ONE BUFFER IS ENOUGH FOR COMMAND FILE
ZERODATA (COMMAND SCANNER VARIABLES)
;TYICORE flag -- if on, FILNAM routine gets input from PNAME+1 bp
; (for program and library requests, source file switching). Other-
; wise, from command input file
;TTYTYI, if set, causes FILNAM to get its input from the terminal.
; (this flag should be SETOM'ed at the start, SETZM'ed on return)
↑TYICORE: 0
↑TTYTYI: 0
ENDDATA
COMMENT ⊗ Opnup -- Open Files
Totally subsidiary to COMND ⊗
OPNUP: XCT COPN(SBITS2) ;DO AN APPROPRIATE OPEN
JRST CNTOPN ;DEVICE NOT AVAILABLE
; ENTER HERE TO TRY A DIFFERENT FILE NAME (SEE GETSRC AND FOLLOWING)
OPNAGN: MOVEW (<CFIL(SBITS2)>,NAME) ;STORE NAMES FOR OTHERS
MOVEW (<CEXT(SBITS2)>,EXTEN)
;;#%%# BY JFR 11-7-74 KEEP TRACK OF PPN
;;=I10= BECAUSE OF SFD'S, PPN IS NOW MORE COMPLEX
NOSFDS<
MOVEW (<CPPN(SBITS2)>,PPN) ;FETCH FROM BLOCK WHICH LOOKUP WILL MANGLE
> ;NOSFDS
SFDS<
MOVE TEMP,PPN ;SAVE PPN - GET IT
JUMPE TEMP,.+3 ;IF ZERO, IT'S OK
TLNN TEMP,777777 ;IF LH NON-ZERO, ALSO OK
MOVEI TEMP,CPATH(SBITS2) ;MUST BE PATH PTR, USE NEW PATH
MOVEM TEMP,CPPN(SBITS2) ;NOW SAVE PPN IN NEW PLACE
MOVSI TEMP,PATHB ;NOW COPY PATH BLOCK
HRRI TEMP,CPATH(SBITS2)
BLT TEMP,CPATH+10(SBITS2)
> ;SFDS
XCT CENT(SBITS2) ;ENTER OR LOOKUP
JRST CNTENT ;CAN'T ENTER OR LOOKUP
;;#%%# BY JFR 11-7-74 KEEP TRACK OF PPN
MOVEW (PPN,<CPPN(SBITS2)>) ;CLOBBER THE NEGATIVE SWAPPED WORD COUNT
HRRZ C,CBFS(SBITS2) ;#BUFFERS
IMULI C,204 ;ASSUME DISK-SIZED BUFFERS
MOVEI B,CMDBUF ;ASSUME NO DYNAMIC BUFFER GRABBING
JUMPL SBITS2,NGOOD ;IF NO DYNAMIC BUFFER GRABBING
PUSH P,A
PUSHJ P,CORGET ;NO, GET SOME BUFFERS
JRST .CORERR ;WHAT?
POP P,A
NGOOD: MOVEM B,JOBFF ;START HERE.
ADDI C,(B) ;END ADDR +1
MOVEI TEMP,1(B)
HRLI TEMP,(B) ;ADDR,,ADDR+1
SETZM -1(TEMP) ;EVIDENCE IS GROWING
BLT TEMP,-1(C) ;AHHHHHH !
XCT CSPC(SBITS2) ;UINBF OR OUTBUF
ALLOK: AOS (P) ;SKIP 2
CNTENT: AOS (P) ;SKIP 1
CNTOPN: POPJ P, ;SKIP 0
COMMENT ⊗ Comnd Itself⊗
COMND:
SETZM DEVICE ;MAKE NO ASSUMPTION YET
SETZM EXTEN ;BLANK EXTENSION, .REL LATER PERHAPS
PUSHJ P,FILNAM ;SCAN A FILE NAME
CAIE A,"@" ;INDIRECT FILE SPECIFICATION?
JRST CHKPNT ;NO
SKIPN TEMP,DEVICE ;PREPARE TO OPEN A NEW
MOVE6 (CMDDEV,<DSK>) ; COMMAND FILE
SETOM DSKSW ;COMMANDS NOW FROM "RPG" FILE
POP P,A ;TOSS OUT RETURN ADDRESS
JRST COMNIT ; GO BACK AND INIT A NEW COMMAND FILE
CHKPNT: CAIE A,"!" ;AM I BEING REPLACED?
JRST GETDST ;NO, THIS IS A NEW COMMAND
LODNEW:
SKIPN TEMP,EXTEN ;ASSUME "DMP" UNLESS
EXPO <
MOVEI TEMP,0
>;EXPO
NOEXPO <
MOVSI TEMP,'DMP'
>;NOEXPO
MOVEM TEMP,EXTEN
SKIPN TEMP,DEVICE ;LIKEWISE "SYS"
MOVE6 (DEVICE,<SYS>)
NOEXPO <
MOVEWI WORD3,1 ;INCREMENT 1 OFF JOBSA
MOVEI P,DEVICE ;CALL FOR RUNJOB
CALL6 P,<SWAP> ;GOODB...
>;NOEXPO
EXPO <
;;%BZ% !
HLLZS EXTEN ;HOPE THIS WINS
SETZM WORD3
SETZM PPN
MOVSI TEMP,1 ;STARTING INCREMENT
HRRI TEMP,DEVICE ;TABLE ADDRESS
CALL6 (TEMP,RUN) ;GOODB...
>;EXPO
; IF THIS IS A BINARY SPEC, INIT BINARY FILE
GETDST:
SKIPN TEMP,DEVICE ;WAS DEVICE SPECIFIED?
MOVE6 (DEVICE,<DSK>) ;IF NOT, MAKE IT DSK
SKIPN NOFILE ;WAS A FILE SPECIFIED?
JRST GTD1 ; YES
CAIN A,"," ;ONLY LIST FILE?
JRST NOBIN ; YES, NO BINARY
SKIPN EOL ;IF EOL, ASSUME END OF DISK FILE
JRST CHKARR ;OR SOMETHING, GO BACK TO SCANNING
POP P,A ; SEQUENCE WHERE PROCESS CAN BE
JRST RELSE ; TERMINATED (OR MAY BE EXTRA LINE)
GTD1:
MOVEW (BINDEV,DEVICE) ;BINARY DEVICE (PROBABLY DSK)
SKIPN TEMP,EXTEN ;ASSUME REL IF NOT SPECIFIED
MOVE6 (EXTEN,<REL>)
NOEXPO <
MOVSI SBITS2,400000 ;KLUGE TO MAKE .REL FILE DUMP NEVER
MOVEM SBITS2,WORD3 ;
>;NOEXPO
EXPO <
SETZM WORD3 ;DUMP NEVER NOT FOR EXPORT
>;EXPO
;;%BZ% ! FOR DATE 75
HLLZS EXTEN ;HOPE THIS WINS
MOVEI SBITS2,BINCDB
PUSHJ P,OPNUP ;OPEN BINARY FILE
IOERR <BINARY DEVICE NOT AVAILABLE>
IOERR <NO ROOM ON BINARY DEVICE>
SETZM WORD3
;;%BZ% ! FOR DATE 75
HLLZS EXTEN ;HOPE THIS WINS
TLO FF,BINARY ;DENOTE BINARY FILE EXISTS
;; %BC%
BAIL <
SKIPG BAILON ;DOING A BAIL COMPILATION?
JRST NBAIO5 ;NO
;;%DO% 1! JFR 7-5-76 USED TO ASSUME 'DSK'
MOVE SBITS2,BINDEV
MOVEM SBITS2,SM1DEV
HRLZI SBITS2,'SM1'
MOVEM SBITS2,EXTEN
NOEXPO<
MOVSI SBITS2,400000 ;KLUGE FOR DUMP NEVER
MOVEM SBITS2,WORD3
>;NOEXPO
EXPO <
SETZM WORD3
>;EXPO
MOVEI SBITS2,SM1CDB
PUSHJ P,OPNUP ;OPEN AND ENTER AND ASSIGN BUFFERS
IOERR <OPEN FAILURE - SM1>
IOERR <ENTER FAILURE - SM1>
SETZM WORD3
;;%BZ% ! FOR DATE 75
HLLZS EXTEN ;HOPE THIS WINS
NBAIO5:
>;BAIL
;; %BC%
CAIE A,"," ;LIST FILE?
JRST CHKARR ; NO, GO ON
NOBIN: MOVE6 (DEVICE,<DSK>) ;ASSUME DSK FOR LISTING FILE
NOEXPO <
MOVE6 (EXTEN,<LST>) ;AND ASSUME EXT OF .LST
>;NOEXPO
EXPO <
MOVE6 (EXTEN,<CRF>) ;AND ASSUME EXT OF .CRF
>;EXPO
PUSHJ P,FILNAM ;SCAN THE FILNAME
SKIPE NOFILE ;IS THERE A LISTING FILE?
JRST CHKARR ; NO, MUST BE FOLLOWED BY "←"
;;=I05=
CAIE A,"="
CAIN A,"←" ;MUST BE ANYWAY
JRST GETLST ; IS
CHKARR:
;;=I05=
CAIE A,"←" ;IF NO "←", THERE'S AN ERROR
CAIN A,"="
JRST NOLST ;NO LISTING FILE
IOERR <SAIL COMMAND ERROR>
GETLST:
MOVEW (LSTDEV,DEVICE) ;LISTING DEVICE
MOVEI SBITS2,LSTCDB
PUSHJ P,OPNUP
IOERR <LISTING DEVICE NOT AVAILABLE>
IOERR <NO ROOM ON LISTING DEVICE>
TLO FF,LISTNG ;DENOTE EXISTENCE OF LST FILE
BAIL<
SKIPLE BAILON
PUSHJ P,BFILOU ;IF BAIL ACTIVE, PUT OUT FILE INFO
>;BAIL
JRST GETSRC ; NOW GET SOURCE FILE (ONE ONLY AT FIRST)
BAIL<
BFILOU: SKIPG BAILON
POPJ P,
SETZ SBITS,
HLLM SBITS,BCORDN ;NO LONGER DOING COORDINATES
PUSHJ P,VALOUT ;END PREVIOUS TABLE
MOVEI SBITS,BAIFIL ;FILE INFO NOW
PUSHJ P,VALOUT
;;=I10= NOW GIVE THEM THE WHOLE PATH
MOVEI SBITS,4+SFDLVL ;4 WORDS FOR FILE:DEV,NAME,EXT,PPN
HRL SBITS,BSRCFN ;FILE #,,# WORDS IN NAME
PUSHJ P,VALOUT
MOVE SBITS,DEVICE
PUSHJ P,VALOUT
MOVE SBITS,NAME
PUSHJ P,VALOUT
MOVE SBITS,EXTEN
PUSHJ P,VALOUT
MOVE SBITS,PPN
;;=I10= TAKE CARE OF PATH.
SFDS<
JUMPE SBITS,.+3 ;IF ZERO, IT'S OK
TLNN SBITS,777777 ;OR IF LH NON-ZERO
MOVE SBITS,PATHB+2 ;IF PTR, HERE IS REAL PPN
PUSHJ P,VALOUT
MOVSI TEMP,-SFDLVL ;NOW PUT OUT THE SFD'S.
HRRI TEMP,PATHB+3 ;THIS IS FIRST SFD
MOVE SBITS,(TEMP) ;GET THE SFD
PUSHJ P,VALOUT
AOBJN TEMP,.-2 ;AND TRY AGAIN IF ANY MORE
> ;SFDS
NOSFDS<
PUSHJ P,VALOUT ;PUT OUT SIMPLE PPN
> ;NOSFDS
POPJ P,
>;BAIL
; ENTER HERE FROM SCAN WHEN EOF IS REACHED AND ANOTHER
; FILE IS NEEDED. IT IS AN ERROR IF NO MORE ARE LEFT
FILEIN:
MOVE TBITS2,SCNWRD
SKIPE SRCDLY ;IF ON, NOT END OF FILE, BUT SWITCH IN
JRST GETSR2
TLNE TBITS2,INSWT ;TIME TO SWITCH BACK TO PREV SOURCE FILE?
JRST UNSWT ;YES
GETSR2: SETZM SRCDLY ;CLEAR THIS
SKIPE EOL ;ARE THERE MORE?
POPJ P, ;NO
JRST GETSR1 ; YES
NOLST:
GETSRC: MOVE6 (DEVICE,<DSK>) ;ASSUME DSK ONCE
GETSR1: MOVSI TEMP,DEFEXT ;AND DEFAULT EXTENSION
MOVEM TEMP,EXTEN
PUSHJ P,FILNAM ;GET A SOURCE FILE NAME
SKIPE NOFILE ;MUST BE ONE
IOERR <SAIL COMMAND ERROR>
PUSH P,PPN ;SAVE PPN FOR SECOND TRY
EXTSPC: MOVEW (SRCDEV,DEVICE) ;SET UP DEVICE
MOVEI SBITS2,SRCCDB
XCT COPN(SBITS2)
IOERR <SOURCE DEVICE NOT AVAILABLE>
MOVE TEMP,EXTEN
PUSHJ P,TRYSRC ;TRY EXTENSION USER SPECIFIED
MOVEI TEMP,0 ; BLANK -- IF USER'S SPEC WAS BLANK
PUSHJ P,TRYSRC ;LAST CHANCE
;TRYSRC DUMPS RETAD, JRSTS OKSRC ON SUCCESS
;; %CT% JFR 8-12-75 try harder
TRYLST:
;;%DR% JFR 8-17-76
SKIPN TEMP,SWTLNK ;SOURCEFILE SWITCHING IN PROGRESS?
JRST .+4 ;CANT FIND ONE. OH WELL
MOVSI TEMP,(TEMP) ;RESTORE THINGS SO MYERR WILL FIND RIGHT FILE
HRRI TEMP,SRCCDB
BLT TEMP,SRCPPN
ERRSPL 1,[[ASCIZ/
Source file not found: @F:@F.@F@G
(type <CR> to specify from TTY)/]
PWORD DEVICE
PWORD NAME
PLEFT EXTEN
PWORD PPN]
;;%DR% ↑
;;=I14= JFR 1-2-77
DEC<
SKIPLE %BATCH ;.gt. if batch job
IOERR <Can't continue> ;if batch, can't recover
>;DEC
POP P,(P) ;SAVED PPN
PUSH P,TTYTYI
SETOM TTYTYI
;;=I11= Bug fix - need to reset DSKSW, too
PUSH P,DSKSW ;SAVE OLD VALUE
SETZM DSKSW ;WE ARE GOING TO BE USING TTY
PUUO 3,[ASCIZ/Source file:/] ;PROMPT
PUSHJ P,GETSRC ;RECURSE
JRST TRYLST ;FAILED AGAIN
;;=I11=
POP P,DSKSW
POP P,TTYTYI
JRST KPOPJ ;SUCCESS AT LAST
;;%CT% ↑
;;%BZ% ! FOR DATE 75
TRYSRC: HLLZM TEMP,EXTEN ;THIS IS EXTENSION TO TRY
SETZM WORD3 ;CLEAN UP
MOVE TEMP,-1(P) ;SAVED PPN
MOVEM TEMP,PPN
PUSHJ P,OPNAGN ;TRY AGAIN
JFCL ;FILE ALREADY OPEN
POPJ P,
POP P,TEMP ;TOSS OUT RETURN ADDRESS
OKSRC:
MOVEM B,BUFADR ;ADDR OF I/O BUFFERS
;;#HU# 6-20-72 DCS BETTER TTY LISTING
SETZM CRIND ;DON'T CRLF/INDENT BEFORE NEXT
SKIPE SWTLNK ;NOW TYPE NEW FILE NAME (NO CRLF IF OUTER LEVEL)
TERPRI
;;%CF% JFR 7-8-75
IFN 0,<
MOVE TEMP,LININD ;#INDENT 3*LININD SPACES
OUTSTR INDTAB(TEMP)
>; IFN 0
;;%CF% ↑
;;#HU#
BAIL<
AOS TEMP,BNSRC ;ONE MORE FILE SEEN
MOVEM TEMP,BSRCFN ;AND IT'S THE CURRENT ONE!
SETZM BSRCFC ;ADVBUF WILL SET IT TO 1
SKIPLE BAILON
PUSHJ P,BFILOU
>;BAIL
POP P,SRCPPN ;TOSS IT OUT
;;%CF% JFR 7-8-75
PUSH P,A
MOVEI A,[ASCIZ/@I@F.@F@G/] ;INDENT SPACES,SIXBIT FILE,.,SIXBIT EXT,PPN
MOVEI B,-1+[PWORD LININD+1
PWORD SRCFIL
PLEFT SRCEXT
PWORD SRCPPN]
PUSHJ P,SPLPRT
POP P,A ;WASN'T THAT EASY??!!!
;;%CF% ↑
HRRZ B,SRCHDR ;NOW SET UP POINTERS TO INDICATE
ADDI B,1 ; THAT A READ SHOULD BE DONE TO
HRRM B,SRCPNT ; SCAN
SETZM 1(B) ;SET FIRST REAL DATA WORD ZERO
CAIN A,"," ;MUST BE COMMA OR END OF LINE
JRST KPOPJ
SKIPN EOL
IOERR <SAIL COMMAND ERROR>
KPOPJ: AOS (P) ;GOOD RETURN
POPJ P,
>;NOTENX
COMMENT ⊗ Unswt -- End of Switched-to-File
(REQUIRE SOURCE!FILE feature) -- Get back to old one, continue via
Seol code in SYM⊗
UNSWT: MOVE B,BUFADR ;ADDRESS OF I/O BUFFERS FOR SOURCE
PUSHJ P,CORREL ;RELEASE IT
MOVE B,SWTLNK ;BACK TO THIS ONE
HRL TEMP,B ;BLT WORD
NOTENX<
HRRI TEMP,SRCCDB
>;NOTENX
TENX<
HRRI TEMP,BGNSWA
>;TENX
BLT TEMP,ENDSRC
SKIPN SWTLNK ;NEW ONE A SWITCHED-TO TOO?
TLZ TBITS2,INSWT ;TURN OFF INSWT BIT
MOVEM TBITS2,SCNWRD
PUSHJ P,CORREL ;RELEASE BLOCK FOR SAVED DATA
;;#HU# 6-20-72 DCS BETTER TTY LISTING
SETOM CRIND ;TYPE CRLF AND INDENT ON NEXT NUMBER
;;#HU#
SETZM LSTCHR ;FOR SAFETY
SETZM SAVCHR
AOS (P) ;FILNAM SUCCEEDS
SETOM SRCDLY ;TELL EOF GUY TO BEHAVE DIFFERENTLY (SYM)
POPJ P,
COMMENT ⊗ Filnam⊗
DSCR FILNAM subroutine
PAR TYICORE -- if on, input is from command file
otherwise, it is from PNAME+1 BP
RES EOF or EOL from WORD
NOFILE set to -1 if no filename exists, else 0
DEVICE has specified name, else unchanged
NAME has filename (in SIXBIT) if specified, else 0
EXTEN has XWD EXT,0 if specified, else unchanged *****
WORD3=0
PPN is 0 or is set to specified user
DES Usually called by COMND routines during new file
initialization -- also called by source file switching
routines with TYICORE set. In addition, FILNAM is used
by library and Rel-file request routines to convert
strings to SIXBIT (also with TYICORE set)
SID returns break char in "A", uses B,C,D
⊗
NOTENX <
?FILNAM:
SETZM NAME ;CLEAR EOF,EOL FLAGS, FILE TABLE ENTRIES
;;%BZ% ! DATE75
HLLZS EXTEN ;FOR DATE75 (DOUBT IF NEED IT)
SETZM WORD3
SETZM PPN
SETZM EOF
SETZM EOL
SETOM NOFILE ;ASSUME "NO FILE SEEN" UNTIL CONTRADICTED
;;=I10= ZERO THE PATH BLOCK (SO WE DON'T GIVE BAIL GARBAGE IF NO SFD'S)
SFDS<
SETZM PATHB ;ZERO THE PATH BLOCK
MOVE A,[XWD PATHB,PATHB+1] ;SINCE BFILOU ASSUMES NO GARBAGE IN IT
BLT A,PATHB+3+SFDLVL ;NOTE EXTRA ZERO BLOCK AT END TO TERMINATE PATH
> ;SFDS
; GET DEVICE (OR FILENAME)
PUSHJ P,WORD ;GET A FILE OR DEVICE NAME
TYMSHR <
TYMUSN: JUMPN B,NONTYM
CAIE A,"(" ;OPENING CHAR FOR USER DIR SCAN
JRST DELIM ;NO. CONTINUE SCAN.
MOVEI D,TYMUSR ;
HRRZM D,PPN
SETZM TYMUSR+1 ;IN CASE NO SECOND PART
SETZM TYMUSR
MOVEI C,=12
HRLI D,(<POINT 6,0>)
SKIPG A,SAVTYI
TUNLP: PUSHJ P,TYI
SETZM SAVTYI
SKIPE EOF
JRST [PUSHJ P,SETEOL
JRST TUNERR]
CAIL A,140
SUBI A,40 ;CONVERT UPPER TO LOWER
CAIE A,")"
CAIGE A,40
JRST TUNEND
SOJL C,TUNLP
SUBI A,40
IDPB A,D
JRST TUNLP
TUNEND: CAIN A,15
PUSHJ P,FAKEOL
CAIE A,")"
TUNERR: IOERR <ILLEGAL USER NAME>
PUSHJ P,WORD
NONTYM:
>;TYMSHR
JUMPE B,DELIM ;IF NOT THERE, CHECK PROPER DELIMITER, RETURN
CAIE A,":" ;A DEVICE?
JRST NAMSET ; NO, MUST BE NAME
MOVEM B,DEVICE ;FILE DEVICE
SETZM NOFILE ; NOW WE SAW SOMETHING
; GET FILE NAME
PUSHJ P,WORD
SKIPN B ;THERE MUST BE ONE
JRST [SKIPE NOFILE ;IF DEVICE ONLY, ACCEPT IT
IOERR <SAIL COMMAND ERROR>
JRST DELIM]
NAMSET: MOVEM B,NAME ;FILE NAME
SETZM NOFILE ;WE SAW SOMETHING
; GET EXTENSION IF THERE IS ONE
CAIE A,"."
JRST CHKPPN ;NO, CHECK PROJ-PROG SPEC
PUSHJ P,WORD
HLLZM B,EXTEN ;EXTENSION
; GET PROJ-PROG NUMBER IF THERE IS ONE
CHKPPN: CAIE A,"["
JRST DELIM ;NONE, CHECK VALID ENDING SEQUENCE
CMU < ;HANDLE CMU PPNS
SKIPG A,SAVTYI ;MAYBE GET LOOKAHEAD CHAR
PUSHJ P,TYI ;GET 1ST PPN CHAR
MOVEM A,SAVTYI ;READY FOR DEC PPN
PUSHJ P,CCVXXX ;CONVERT IT
CAIL A,"A" ;LETTER?
CAILE A,"Z"
JRST DECPPN ;NO, BETTER BE DEC PPN
SETZM SAVTYI
MOVEI B,-"A"(A) ;COLLECT PPN IN B
MOVEI C,3 ;SET UP FOR 3 DIGITS
CMUPP1: PUSHJ P,CCVTYI ;GET DIGIT
CAIL A,"0" ;MAKE SURE IT IS ONE
CAILE A,"9"
IOERR <ILLEGAL PPN>
IMULI B,=10 ;MAKE ROOM FOR DIGIT
ADDI B,-"0"(A) ;PUT IT IN
SOJG C,CMUPP1
ADDI B,11 ;MAKE MIN CMU PROJ BE 11
HRLM B,PPN ;INSERT ACCT NO.
PUSHJ P,CCVTYI ;GET 1ST LETTER OF MAN ON.
CAIL A,"A" ;IS IT A LETTER?
CAILE A,"Z"
IOERR <ILLEGAL PPN>
MOVEI B,-"A"(A) ;COLLECT MAN NO. IN B
PUSHJ P,CCVTYI ;GET SECOND LETTER
CAIL A,"A" ;IS IT FOR REAL?
CAILE A,"Z"
IOERR <ILLEGAL PPN>
IMULI B,=26 ;MAKE ROOM FOR LETTER
ADDI B,-"A"(A) ;INSERT IT
PUSHJ P,CCVTYI ;GET NUMBER
CAIL A,"0" ;CHECK IT
CAILE A,"9"
IOERR <ILLEGAL PPN>
IMULI B,=10 ;MAKE ROOM
ADDI B,-"0"(A) ;INSERT
PUSHJ P,CCVTYI ;GET LAST CHAR
IMULI B,=36 ;MAKE ROOM
CAIL A,"A" ;LETTER?
CAILE A,"Z"
JRST CMUPP2 ;NO, BETTER BE DIGIT
ADDI B,=10-"A"(A) ;LEAVE ROOM FOR DIGITS
JRST CMUPP3 ;AROUND DIGIT CODE
CMUPP2: CAIL A,"0" ;DIGIT?
CAILE A,"9"
IOERR <ILLEGAL PPN>
ADDI B,-"0"(A)
CMUPP3: HRRM B,PPN
PUSHJ P,WORD ;PICK UP ]
JUMPL A,PPNFIN+1
JRST PPNFIN
CCVTYI: PUSHJ P,TYI
CCVXXX: CAIL A,"a" ;is it lower case?
CAILE A,"z" ;WELL?
POPJ P, ;NOT LC
TRZ A,40 ;MAKE IT UC
POPJ P,
DECPPN:
>;CMU
PUSHJ P,WORD ;PROJ
NODEC<
SKIPE B ;CAN'T BE 0
CAIE A,"," ;MUST BE COMMA
IOERR <SAIL COMMAND ERROR>
>;NODEC
DEC<
;;=I10= FOR SFD'S WE WANT TO FOLLOW DEC STANDARD PATH FORMAT, ALLOW ZERO
; SKIPE B ;CAN'T BE 0
CAIE A,"," ;MUST BE COMMA
IOERR <Illegal path>
;;=I10= SFD PATCH
EXTERNAL MYPPN
JUMPE B,[HLLZ B,MYPPN ;IF PROJ OMITTED, USE OURS
JRST PRJDON]
>;DEC
PUSH P,FPOPJ ;CALL IN LINE
FJUST:
IFN SIXSW,<
SUBI C,3
SKIPGE C
MOVEI C,0
IMULI C,-6
LSH B,(C) ;RIGHT JUSTIFY WORD IN 3 CHARACTERS
>;IFN SIXSW
IFE SIXSW,<
MOVEI TEMP,0
BACKL: MOVEI A,0
LSHC A,6 ;CONVERT TO OCTAL PPN
CAIL A,'0'
CAILE A,'7'
IOERR <NON-OCTAL PPN>
LSH TEMP,3
IORI TEMP,-'0'(A)
JUMPN B,BACKL
MOVS B,TEMP
>;IFE SIXSW
FPOPJ: POPJ P,.+1 ;ALSO CALLED BELOW
DEC<
;;=I10= SFD
PRJDON: HLLZM B,PPN ;PROJ
PUSHJ P,WORD
;;=I10= SFD
; SKIPE B
SFDS<
MOVE C,A ;SAVE A, THE SEPARATOR CHARACTER
CAIN A,"," ;OK IF COMMA
JRST .+3 ; OK
> ;SFDS
CAIE A,"]" ;IF 0 WORD OR NO ], ERROR
IOERR <Illegal path>
JUMPE B,[HRLZ B,MYPPN ;IF NO PROG. NO, USE OURS
JRST PMRDON]
PUSHJ P,FJUST ;RIGHT JUSTIFY
PMRDON: HLRM B,PPN ;PROG
SFDS<
CAIN C,"]" ;DONE WITH PATH?
JRST PPNFIN ;YES
SETZM PATHB ;NO - LOOK FOR SFD'S
SETZM PATHB+1 ;INITIALIZE PATH BLOCK
MOVE A,PPN
MOVEM A,PATHB+2
MOVEI A,PATHB ;AND USE PTR TO BLOCK AS PPN
MOVEM A,PPN
MOVEI PNT,PATHB+3 ;FIRST SFD PLACE
MOVEI TEMP,5 ;MAX NO. OF SFD'S
SFDSC: PUSHJ P,WORD ;NOW GET SFD
MOVEM B,(PNT) ;AND USE IT
CAIN A,"]" ;IF BRACKET, WE'RE DONE
JRST SFDDON
CAIE A,"," ;ELSE, BETTER BE COMMA
IOERR <Illegal path>
MOVEI PNT,1(PNT) ;NOW PLACE FOR NEXT SFD
SOJG TEMP,SFDSC ;GET NEXT IF NOT TOO MANY
IOERR <Illegal path>
SFDDON: SETZM 1(PNT) ;GUARANTEE PATH ENDS IN 0 (SHOULDN'T BE NEEDED)
PPNFIN:
> ;SFDS
;;=I10= ↑↑
>;DEC
NODEC<
HLLZM B,PPN ;PROJ
PUSHJ P,WORD
SKIPE B
CAIE A,"]" ;IF 0 WORD OR NO ], ERROR
IOERR <SAIL COMMAND ERROR>
PUSHJ P,FJUST ;RIGHT JUSTIFY
HLRM B,PPN ;PROG
>;NODEC
CMU <
PPNFIN:
>;CMU
PUSHJ P,WORD ;TOSS OUT ]
SKIPE B ;MUST BE NO WORD THIS TIME
IOERR <SAIL COMMAND ERROR>
COMMENT ⊗ Delim -- Handle Switches⊗
DELIM:
CAIE A,"/" ;IGNORE ANY SWITCH ASSIGNMENTS
JRST DELIM2
MOVEI PNT,DELIM ;RETURN ADDRESS
>;NOTENX
↑↑SWTGET:TLZ FF,FFTEMP ;KEEP TRACK OF SIGN
SETZB C,D ;COLLECT ANY NUMBERS
SWGMOR: PUSHJ P,TYI ;GET SWITCH INFO
SWGPAR: CAIL A,"0" ;DIGIT?
CAILE A,"9"
JRST SWTDSP ; NO
IMULI C,=10
ASH D,3
ADDI C,-"0"(A) ;YES, COLLECT NUMBER
IORI D,-"0"(A) ;COLLECT OCTAL NUMBER TOO.
JRST SWGMOR ;AND KEEP GOING
SWTDSP: CAIE A,"-" ;NEGATE THE COUNTS GOING
JRST SWDGO
TLO FF,FFTEMP ;NOW WILL BE MINUS!
JRST SWGMOR ;AND KEEP GOING
SWDGO: SUBI A,"A" ;ALL SWITCHES ARE LETTERS
JUMPL A,INVSW ;INVALID SWITCH
CAILE A,"Z"-"A" ;CONVERT LOWER CASE
SUBI A,40 ;
CAILE A,"Z"-"A" ;NOW MUST BE IN RANGE
JRST INVSW ; INVALID SWITCH
TLNE FF,FFTEMP ;NEG?
MOVNS D ; YES, IF OCTAL
IDIVI A,7 ;MAKE INDEX IN A, DISPLACEMENT IN B
IMULI B,-5 ;MAKE A BYTE POINTER
ADDI B,37
MOVE TEMP,[POINT 5,SWTTBL(A)]
DPB B,[POINT 6,TEMP,5] ;P FIELD
LDB A,TEMP ;GET DISPATCH
PUSHJ P,@SWDSP(A) ;CALL SWITCH ROUTINE
PUSHJ P,TYI ;GET NEXT CHAR
JRST (PNT) ;LOOK FOR MORE SWITCHES
NOTENX<
;;%DN% JFR 7-1-76 /A
SWTTBL: BYTE (5)20,14,10,7,0,11,0 ;A-B-C-D-e-F-g
BYTE (5)13,0,0,12,2,1,0 ;H-i-j-K-L-M-n
BYTE (5)0,3,4,5,6,0,0 ;o-P-Q-R-S-t-u
BYTE (5)15,16,17,0,0,0,0 ;V-W-X-y-z-0-0
>;NOTENX
TENX<
SWTTBL: BYTE (5)24,20,10,7,0,11,17 ;A-B-C-D-e-F-G
BYTE (5)13,14,0,12,2,1,0 ;H-I-j-K-L-M-n
BYTE (5)0,3,4,5,6,15,16 ;o-P-Q-R-S-T-U
BYTE (5)21,22,23,0,0,0,0 ;V-W-X-y-z-0-0
>;TENX
DEFINE RWITCH(NUM,DESC) <
II←←.
USE SWTS
II ;DISPATCH TO THIS ROUTINE
USE
>
↑SWDSP: BLOCK =21 ;ENOUGH + SOME MORE
SET SWTS,SWDSP ;PREPARE VECTOR PC
SWITCH (0 , INVALID)
SUB P,X11 ;REMOVE RETURN
INVSW: ERR <INVALID SWITCH IN COMMAND LINE>,1
PUSHJ P,TYI ;GO BACK WHERE YOU CAME FROM
JRST (PNT)
SWITCH (1 , #M -- debugging mode setting)
; DCS ADDED LABEL, 9-21-71
↑↑STMD: POP P,B ;RETURN ADDRESS
IFN FTDEBUG,<
SETZM MULTP ;FOR MODE 5.
SETZM PLINSW
CAIE C,4
SETZM .DBG. ;TO GET ALL THE SWITCHES INITIALIZED.
;;#GH# DCS 2-1-72 (2-5) REDEFINE 6M -- SCANNER BREAK
HRLOI TEMP,400000 ;XWD 400000,,-1 FOR SCAN BREAK
CAIG C,6 ;MUST BE LESS 6 FOR VALID MODE
XCT DBMD(C) ;SUB-DISPATCH
TABCONDATA (DEBUGGING MODE SETTERS)
DBMD: JFCL ; 0 -- NO EFFECT
HLLOS .DBG. ; 1 -- EXEC ROUTINES ONLY [0,,-1]
SETZM .DBG. ; 2 -- DON'T DEBUG [0,,0]
SETOM .DBG. ; 3 -- EXECS AND PRODUCTIONS [-1,,-1]
SETOM MULTP ; 4 -- DON'T STOP WHILE DEBUGGING
SETOM PLINSW ; 5 -- JUST PRINT LINES
MOVEM TEMP,.DBG. ; 6 -- BREAK AFTER EACH SCAN [400000,,-1]
; <ESC>I IS [400000,,377777] or .DBG.
;;#GH# (2-5)
ENDDATA
JRST (B) ;RETURN FROM DEBUG SWITCH ROUTINE
>
IFE FTDEBUG ,<JRST INVSW>
SWITCH (2 , #L -- listing control)
CAMN D,[-1]
MOVEI D,5234 ;LENGTH OF DDT THESE DAYS.
;INCLUDES SAIL LOWER SEGMENT.
CAMN D,[-2]
JRST [MOVEI D,12237 ;GOOD GUESS FOR LENGTH OF RAID TODAY
; THIS FIGURE IS WITH SAIL LOW SEGMENT.
SKIPE JOBDDT ; HERE IS A BETTER NUMBER
MOVEI D,LPSERR-1 ;END OF DDT.
JRST OUTLIT]
OUTLIT: MOVEM D,LSTSTRT ;SET IT UP
POPJ P,
;;%DD% JFR 10-24-75 IF C=0, THEN DOUBLE, ELSE SET VALUE TO RH(C)
SWITCH (3 , P -- double P-stack)
JUMPN C,.+3
HRRZ C,PDLMAX
LSH C,1 ;DOUBLE IT
HRRM C,PDLMAX
POPJ P,
SWITCH (4 , Q -- double SP-stack)
JUMPN C,.+3
HRRZ C,SPMAX
LSH C,1
HRRM C,SPMAX
POPJ P,
SWITCH ( 5 , R -- double parse and semantic stacks)
JUMPN C,.+3
HRRZ C,PPMAX
LSH C,1
HRRM C,PPMAX
HRRM C,GPMAX
HRRM C,PCMAX ;ALSO MAIN PARSE CONTROL
HRRM C,SCWMAX
POPJ P,
SWITCH (6 , #S -- set string space size)
HRRM C,STMAXX ;CHANGE STRING SPACE
POPJ P,
SWITCH (7 , D -- double define stack)
JUMPN C,.+3
HRRZ C,DFMAX
LSH C,1
HRRM C,DFMAX
POPJ P,
SWITCH (10 , C -- turn on CREF listing if listing)
MOVSI TEMP,CREFIT
IORM TEMP,SCNWRD
TLO FF,CREFSW
POPJ P,
SWITCH (11 , F -- set listing format bits in SCNWRD)
;;%DF% ! RHT 10-25-75
MOVEM D,FMTWRD
;;%DB% JFR 9-21-75
MOVE TEMP,[XWD 760000,1]
ANDCAM TEMP,SCNWRD ;TURN OFF ALL USER-CONTROLLED BITS
ANDI D,77 ;ONLY LOW SIX BITS MATTER
ROT D,-5 ;SUBSTITUTE USER OPTIONS
;;%DB% ↑
IORM D,SCNWRD ;MARK OPTIONS
POPJ P,
SWITCH (12 , K -- insert counters into loops)
TLNN FF,LISTNG ;MAKE SURE WE'RE LISTING
POPJ P, ;INSERT COUNTERS ONLY WHEN LISTING
MOVSI TEMP,CREFIT ;GET CREF BIT
TDNE TEMP,SCNWRD ;ARE WE CREFFING
ERR (<COUNTERS AND CREF ARE PRESENTLY INCOMPATIBLE>)
MOVEI TEMP,MACEXP ;SPECIFY DESIRED FORMAT FOR
HRLM TEMP,SCNWRD ;LISTING FILE
;;%DH% 2! JFR 11-22-75
LSH TEMP,-=13
MOVEM TEMP,FMTWRD
SETOM KOUNT ;TURN ON THE COUNTING SWITCH
POPJ P, ;RETURN
SWITCH (13, H -- Generate Two-Segment Code)
SETOM HISW ;THIS TRIGGERS IT
POPJ P,
NOTENX<
BAIL<
SWITCH (14, B -- Debugger option.)
; LEQ 0 BAIL OFF
; BITS
; 1 COORDS--0 MEANS NO, 1 MEANS YES
; 2 SYMS--0 MEANS JUST PROCS,PARAMS,INTERNALS; 1 MEANS ALL
; 4 PD FOR SIMPLE PROC--0 MEANS NO, 1 MEANS YES
MOVEM D,BAILON
POPJ P,
>;BAIL
SWITCH (15, V -- OVERLAY CODE, FORCE LINKS TO LOW SEG)
SETOM OVRSAI
POPJ P,
SWITCH (16, W -- "WHERE" GENERATE OPTIONAL LOADER SYMBOLS)
SETOM WHERSW
POPJ P,
SWITCH (17, X -- "XTEND" COMPILER SAVE/RESTART FACILITY)
HLLOS XTFLAG
POPJ P,
SWITCH (20, A -- COMPILED CODE OPTIONS)
MOVEM D,ASWITCH
POPJ P,
>;NOTENX
TENX<
SWITCH (14, I -- Do not generate Two-Segment Code)
SETZM HISW
POPJ P,
SWITCH (15, T -- Load with DDT)
SETOM LODMOD
SETOM LODDDT
POPJ P,
SWITCH (16, U -- Load with SDDT)
SETOM LODMOD
SETOM LODDDT
SETOM LODSDT
POPJ P,
SWITCH (17,G -- Load after compilation)
SETOM LODMOD
POPJ P,
BAIL<
SWITCH (20, B -- Debugger options.)
; LEQ 0 BAIL OFF
; BITS
; 1 COORDS--0 MEANS NO, 1 MEANS YES
; 2 SYMS--0 MEANS JUST PROCS,PARAMS,INTERNALS; 1 MEANS ALL
; 4 PD FOR SIMPLE PROC--0 MEANS NO, 1 MEANS YES
MOVEM D,BAILON
POPJ P,
>;BAIL
SWITCH (21, V -- OVERLAY CODE, FORCE LINKS TO LOW SEG)
SETOM OVRSAI
POPJ P,
SWITCH (22, W -- "WHERE" GENERATE OPTIONAL LOADER SYMBOLS)
SETOM WHERSW
POPJ P,
SWITCH (23, X -- "XTEND" COMPILER SAVE/RESTART FACILITY)
HLLOS XTFLAG
POPJ P,
SWITCH (24, A -- COMPILED CODE OPTIONS)
MOVEM D,ASWITCH
POPJ P,
>;TENX
; END OF SWITCH HANDLERS
NOTENX <
;Above switch goes to end of file.
DELIM2: CAIE A,"("
JRST DELIM4
PUSHJ P,TYI ;GET NEXT CHAR
DELIM3: TLZ FF,FFTEMP ;KEEP TRACK OF SIGN OF ANY NUMBERS
SETZB C,D
JSP PNT,SWGPAR ;GO LOOK AT SWITCHES
CAIE A,")"
JRST DELIM3
PUSHJ P,TYI
DELIM4: CAIN A,15 ;IF CR, CALL ROUTINE TO
PUSHJ P,FAKEOL ; SET EOL SWITCH (PERHAPS EOF)
SKIPE EOF ;SET EOL IF EOF
SETOM EOL
DELIM1:
CAIN A,"," ;FILE NAME MUST BE FOLLOWED
POPJ P, ; BY , OR ← OR
;;=I05=
CAIE A,"="
CAIN A,"←" ; @ OR ! OR EOL
POPJ P,
CAIN A,"@"
POPJ P,
CAIN A,"!"
POPJ P,
SKIPE EOL
POPJ P,
IOERR <SAIL COMMAND ERROR>
COMMENT ⊗ Word
Fetches one name, ext, etc. from Command File.
Leaves character which broke scan in "A", -1 if EOL.
Sets EOL if CRLF or end of file, EOF and EOL for end of file.
Returns word (sixbit) left-justified in "B", zero if none.
ACS: Results in A,B; uses also C,D ⊗
WORD:
TLZ FF,FFTEMP ;INDICATE NO GOOD CHARS SEEN.
MOVEI B,0
MOVEI C,6 ;INITIALIZE
MOVE D,[POINT 6,B]
SKIPG A,SAVTYI ;GET LOOKAHEAD CHAR IF ANY
WLUP: PUSHJ P,TYI ;GET A CHARACTER
SETZM SAVTYI
SKIPE EOF ;ON EOF, SET EOL
JRST SETEOL
LORD: CAIL A,"a"
CAILE A,"z" ;IF LOWER, CONVERT TO UPPER
JRST LUPORD ;CHECK A-Z, 0-9 IF NOT
SUBI A,"a"-"A" ;CONVERT TO UPPER CASE
LUPORD: CAIL A,"A"
CAILE A,"Z" ;CHECK LETTER
JRST [CAIL A,"0"
CAILE A,"9" ; NO, CHECK DIGIT
JRST ENDWRD ; NOT LETTER OR DIGIT
JRST .+1] ;A DIGIT
TLO FF,FFTEMP ;A GOOD CHAR SEEN.
STILIN: SUBI A,40 ;CONVERT TO SIXBIT
SKIPN C ; COUNT EXHAUSTED?
JRST WLUP ; YES, CONTINUE UNTIL END OF WORD
IDPB A,D ; COLLECT WORD
SOJA C,WLUP ; CONTINUE
ENDWRD: CAIN A," " ;A SPACE OF SOME VARIETY?
JRST [TLNN FF,FFTEMP ;HAVE WE SEEN ANYTHING?
JRST WLUP ;NOT YET.
JRST .+1]
CAIE A,15 ; CARRIAGE RETURN?
POPJ P, ; NO
FAKEOL: PUSHJ P,TYI ;GET LINE FEED
SKIPN DSKSW ;IF IN DISK MODE, MAKE SURE
JRST SETEOL ;THERE'S NO GARBAGE LEFT
FNDEOF: PUSHJ P,TYI
JUMPL A,SETEOL ;END OF FILE RIGHT AWAY
CAIG A,40 ;IGNORE TABS, BLANKS, AND THE LIKE
JRST FNDEOF
MOVEM A,SAVTYI ;LOOKAHEAD CHAR -- WILL BE PICKED UP NEXT
SETEOL: SETOB A,EOL ;MARK END OF LINE
SKIPN DSKSW ;IF IN TTY MODE, RELEASE DEVICE
RELEASE CMND,0 ;RELEASE COMMAND FILE SO THAT TTY
POPJ P, ;CAN BE USED FOR INPUT
; Tyi
; Get one character, set EOF on EOF, ignore zeros
TYI: SKIPE TTYTYI ;IF GETTING INPUT FROM TERINAL,
JRST TTYDO ;DO SO!
SKIPE TYICORE ;FROM COMMAND FILE?
JRST TYCOR ; NO, FROM A STRING IN PNAME, PNAME+1
SOSLE CMDCNT
JRST TYIK
IFN TMPCSW,<
SKIPGE CMDMOD ;IF USING TEMP CORE
JRST TYDUN ;ALL DONE.
>;IFN TMPCSW
INPUT CMND,0
TSTERR CMND
IOERR <INPUT ERROR ON COMMAND DEVICE>
TSTEOF CMND,<[TYDUN: SETOB A,EOF
POPJ P,]>
TYIK: IBP CMDPNT
MOVEI A,1
TDNE A,@CMDPNT
JRST LINENO
LDB A,CMDPNT
JUMPE A,TYI
POPJ P,
LINENO: AOS CMDPNT
MOVNI A,5
ADDM A,CMDCNT
JRST TYI
TTYDO: SKIPL TTYTYI ;IF NOT BEGINNING,
INCHRS A ;JUST READ A CHAR AND SKIP
INCHWL A ;OTHERWISE WAIT TILL HE BEGINS.
HRRZS TTYTYI ;CHANGE FLAG TO NOT FIRST TIME.
POPJ P,
TYCOR: SOS A,PNAME ;TEST ALL DONE
TRNE A,400000 ;ALL DONE?
JRST [SETOB A,EOL ;MARK DONE
SETZM TYICORE ;FOR SOURCE FILE SWITCHING
;DCS 8/21/70
SETZM PNAME ;DCS 5/2/71
POPJ P,]
ILDB A,PNAME+1 ;GET NEXT CHARACTER
POPJ P,
NOEXPO <
INTERNAL SAVDMP
↑SAVDMP: MOVEM TEMP,TEMPSV
HRRZ TEMP,JOBSA
HRRZM TEMP,SWPTBL+3
CALLI TEMP,400062 ;GETNAM
MOVEM TEMP,SWPTBL+1
CALLI ;RESET JOBFF
HRRZ TEMP,JOBFF
CALL6 (TEMP,CORE) ;CUT CORE IMAGE TO MINIMUM
ERR <CORE ERROR DURING SAVDMP OPERATION>
MOVSI TEMP,SWPTBL
CALL6 (TEMP,SWAP)
JRST @JOBDDT
SWPTBL: SIXBIT /DSK/
SIXBIT /SAIL/
SIXBIT /DMP/
0
0
INTERNAL RAIDST
↑RAIDST: MOVEM TEMP,TEMPSV
SKIPN TEMP,JOBDDT ;JOBDDT BETTER BE THERE
ERR <DRYROT -- RAIDST> ;
MOVEM LPSA,LPSASV ;NEED TWO AC'S
MOVE LPSA,[POINT 7,RAICDS] ;
MOVE TEMP,-3(TEMP) ;
MOVEM LPSA,-1(TEMP)
RAITL: ILDB TEMP,LPSA ;PICK UP CHAR
CAIN TEMP,33 ;IS IT PSEUDO ALT
MOVEI TEMP,175 ;YES
DPB TEMP,LPSA
JUMPN TEMP,RAITL ;LOOP
MOVE LPSA,LPSASV
MOVE TEMP,TEMPSV
JRST @JOBDDT
TEMPSV: 0
LPSASV: 0
RAICDS:ASCIZ /SAIL≠:A≠;B≠;C≠;D≠;LPSA≠;TEMP≠;SBITS≠;SBITS2≠;PNT≠;PNT2≠;24≠I/
>;NOEXPO
SUBTTL Production Interpreter
>;NOTENX
;Closes back to DELIM2.